1 | | % Heinrich Heine Universitaet Duesseldorf |
2 | | % (c) 2021-2025 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, |
3 | | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) |
4 | | |
5 | | :- module(visb_visualiser,[load_visb_file/1, |
6 | | load_visb_definitions_from_list_of_facts/2, |
7 | | load_visb_definitions_from_term/2, |
8 | | load_visb_file_if_necessary/1, |
9 | | visb_file_is_loaded/1, visb_file_is_loaded/3, |
10 | | visb_current_state_can_be_visualised/0, |
11 | | get_default_visb_file/2, extended_static_check_default_visb_file/0, |
12 | | load_default_visb_file_if_necessary/0, |
13 | | generate_visb_html_for_history/1, generate_visb_html_for_history/2, |
14 | | generate_visb_html_for_history_with_vars/1, |
15 | | generate_visb_html_for_history_with_source/1, |
16 | | generate_visb_html_for_current_state/1, generate_visb_html_for_current_state/2, |
17 | | generate_visb_html_codes_for_states/3, |
18 | | generate_visb_html/3, |
19 | | tcltk_get_visb_items/1, tcltk_get_visb_events/1, |
20 | | tcltk_get_visb_objects/1, tcltk_get_visb_hovers/1, |
21 | | get_visb_items/1, get_visb_attributes_for_state/2, |
22 | | get_visb_click_events/1, get_visb_hovers/1, |
23 | | perform_visb_click_event/4, |
24 | | tcltk_perform_visb_click_event/1, |
25 | | get_visb_default_svg_file_contents/1, |
26 | | get_visb_svg_objects/1]). |
27 | | |
28 | | :- use_module(probsrc(module_information),[module_info/2]). |
29 | | :- module_info(group,visualization). |
30 | | :- module_info(description,'This module provides VisB visualisation functionality.'). |
31 | | |
32 | | % special SVG object attributes treated by VisB |
33 | | % title (creates hover tooltip; currently only works with objects created by VisB itself) |
34 | | % id |
35 | | % svg_class |
36 | | % text |
37 | | % hovers |
38 | | % event, events |
39 | | % predicate |
40 | | |
41 | | :- meta_predicate process_repeat(-,-,-,2). |
42 | | |
43 | | :- use_module(extrasrc(json_parser),[json_parse_file/3]). |
44 | | :- use_module(library(lists)). |
45 | | |
46 | | :- use_module(probsrc(error_manager)). |
47 | | :- use_module(probsrc(preferences),[get_preference/2]). |
48 | | :- use_module(probsrc(debug)). |
49 | | :- use_module(probsrc(state_space), [visited_expression/2, visited_state_corresponds_to_initialised_b_machine/1, |
50 | | get_constants_id_for_state_id/2, get_constants_state_id_for_id/2, |
51 | | set_context_state/2, clear_context_state/0, |
52 | | transition/3, transition/4, invariant_violated/1, invariant_not_yet_checked/1, |
53 | | multiple_concrete_constants_exist/0, is_concrete_constants_state_id/1]). |
54 | | :- use_module(probsrc(translate), [translate_bvalue_to_codes/2, translate_bvalue_to_codes_with_limit/3, |
55 | | translate_bvalue_with_limit/3]). |
56 | | :- use_module(probsrc(specfile),[eventb_mode/0, |
57 | | state_corresponds_to_initialised_b_machine/2, |
58 | | state_corresponds_to_fully_setup_b_machine/2, |
59 | | state_corresponds_to_set_up_constants_only/2, |
60 | | expand_to_constants_and_variables/3, |
61 | | extract_variables_from_state/2]). |
62 | | |
63 | | :- use_module(probsrc(tools),[start_ms_timer/1,stop_ms_walltimer_with_msg/2, ajoin_with_sep/3]). |
64 | | :- use_module(probsrc(tools_io),[safe_open_file/4, with_open_stream_to_codes/4]). |
65 | | :- use_module(probsrc(bmachine), [b_machine_name/1, b_get_definition/5, bmachine_is_precompiled/0, |
66 | | determine_type_of_formula/2, determine_type_of_formula/3]). |
67 | | :- use_module(probsrc(bsyntaxtree), [get_texpr_ids/2]). |
68 | | :- use_module(probsrc(tools_lists),[include_maplist/3]). |
69 | | :- use_module(probsrc(tools),[split_list/4, html_escape_codes/2]). |
70 | | :- use_module(probsrc(tools_matching),[get_all_svg_attributes/1, is_svg_attribute/1, is_virtual_svg_attribute/1, |
71 | | is_svg_number_attribute/2, is_svg_color_attribute/1]). |
72 | | |
73 | | % -------------------------- |
74 | | |
75 | | % facts storing loaded JSON VisB file: |
76 | | :- dynamic visb_file_loaded/3, visb_svg_file/5, visb_empty_svg_box_height_width/3, |
77 | | visb_definition/6, visb_special_definition/6, |
78 | | visb_item/7, |
79 | | visb_event/6, visb_hover/6, visb_has_hovers/1, visb_has_visibility_hover/1, |
80 | | visb_event_enable_list/5, |
81 | | visb_svg_object/5, |
82 | | visb_svg_child/2, visb_svg_parent/2. |
83 | | :- dynamic auxiliary_visb_event/5. |
84 | | % visb_svg_file(SVGFile, AbsolutePathSVGFile, JSONFileFromWhichWeImportSVG,PosTerm,ModLocTime) |
85 | | % visb_item(SVGID,Attribute,TypedExpression,UsedIds,Description/Comment,StartPos,OtherMetaInfos) |
86 | | % visb_event(SVGID,Event,PredicateList,TypedPredicate,File,Pos) |
87 | | % visb_svg_object(SVGID,SVG_Class,AttrList,Description/Comment,Pos) ; AttrList contains svg_attribute(Attr,Val) |
88 | | |
89 | | reset_visb :- debug_println(9,resetting_visb), |
90 | | retractall(visb_file_loaded(_,_,_)), |
91 | | retractall(visb_empty_svg_box_height_width(_,_,_)), |
92 | | retractall(visb_svg_file(_,_,_,_,_)), |
93 | | retractall(visb_definition(_,_,_,_,_,_)), |
94 | | retractall(visb_special_definition(_,_,_,_,_,_)), |
95 | | retractall(visb_item(_,_,_,_,_,_,_)), |
96 | | retractall(visb_event(_,_,_,_,_,_)), |
97 | | retractall(visb_hover(_,_,_,_,_,_)), |
98 | | retractall(visb_has_hovers(_)), |
99 | | retractall(visb_has_visibility_hover(_)), |
100 | | retractall(visb_event_enable_list(_,_,_,_,_)), |
101 | | retractall(auxiliary_visb_event(_,_,_,_,_)), |
102 | | retractall(visb_svg_object(_,_,_,_,_)), |
103 | | retractall(visb_svg_child(_,_)), |
104 | | retractall(visb_svg_parent(_,_)), |
105 | | reset_auto_attrs. |
106 | | |
107 | | visb_file_is_loaded(JSONFile) :- |
108 | | visb_file_is_loaded(JSONFile,_,true). |
109 | | visb_file_is_loaded(JSONFile,SVGFile,AllowEmpty) :- |
110 | | visb_file_loaded(JSONFile,_,_), |
111 | | (visb_svg_file(_,SVGFile,_,_,_) -> true |
112 | | ; visb_empty_svg_box_height_width(_,_,_) -> SVGFile = '' |
113 | | ; user_has_defined_visb_objects -> SVGFile = '' |
114 | | ; JSONFile='' -> |
115 | | AllowEmpty=true, |
116 | | add_warning(visb_visualiser,'No VISB_SVG_FILE or VISB_SVG_OBJECTS specified in DEFINITIONS',''), |
117 | | % Note: warning also generated below No VisB JSON file is specified and no VISB_SVG_OBJECTS were created |
118 | | SVGFile = '' |
119 | | ; add_warning(visb_visualiser,'No SVG file or objects specified for VisB file:',JSONFile), |
120 | | AllowEmpty=true, |
121 | | SVGFile = '' |
122 | | ). |
123 | | |
124 | | no_svg_available :- |
125 | | \+ user_has_defined_visb_objects, |
126 | | no_svg_file_available, |
127 | | \+ visb_empty_svg_box_height_width(_,_,_). % no SVG box provided |
128 | | |
129 | | no_svg_file_available :- (visb_svg_file(_,SVGFile,_,_,_) -> SVGFile='' ; true). |
130 | | |
131 | | :- use_module(probsrc(state_space),[current_state_id/1, |
132 | | current_state_corresponds_to_setup_constants_b_machine/0]). |
133 | | visb_current_state_can_be_visualised :- |
134 | | %visb_file_is_loaded(_), % no longer checked; Tcl/Tk will automatically load VisB file if required |
135 | | (b_or_z_mode -> current_state_corresponds_to_setup_constants_b_machine |
136 | | ; \+ current_state_id(root) |
137 | | ). |
138 | | |
139 | | :- use_module(probsrc(eventhandling),[register_event_listener/3]). |
140 | | :- register_event_listener(reset_specification,reset_visb,'Reset VisB information'). |
141 | | :- register_event_listener(reset_prob,reset_visb,'Reset VisB information'). |
142 | | |
143 | | %static_check_visb :- % now done when adding items and not storing multiple items |
144 | | % visb_item(ID,Attr,F1,_,_,Pos1), visb_item(ID,Attr,F2,_,Pos2), F1 @< F2, |
145 | | % add_warning(visb_visualiser,'Multiple formulas for SVG identifier and attribute:',ID/Attr,Pos1), |
146 | | % add_message(visb_visualiser,'Location of second formula for:',ID/Attr,Pos2), |
147 | | % fail. |
148 | | % TO DO: some sanity checks on attributes and values |
149 | | static_check_visb :- |
150 | | no_svg_file_available, |
151 | ? | visb_hover(SVGID,_ID,Attr,_Enter,_Exit,Pos), |
152 | | \+ svg_id_exists(SVGID), |
153 | | ajoin(['Hover for attribute ',Attr,' has unknown trigger-id (can lead to blank visualisation): '],Msg), |
154 | | add_warning(visb_visualiser,Msg,SVGID,Pos), |
155 | | fail. |
156 | | static_check_visb :- |
157 | | no_svg_file_available, |
158 | ? | visb_hover(SVGID,ID,Attr,_Enter,_Exit,Pos), ID \= SVGID, |
159 | | \+ svg_id_exists(ID), |
160 | | ajoin(['Hover for attribute ',Attr,' has unknown id (can lead to blank visualisation): '],Msg), |
161 | | add_warning(visb_visualiser,Msg,ID,Pos), |
162 | | fail. |
163 | | static_check_visb :- |
164 | | visb_svg_file(SvgFile,_,_,Pos,_), |
165 | | SvgFile \= '', |
166 | | visb_empty_svg_box_height_width(H,W,ViewBox), |
167 | | ajoin(['VISB_SVG_BOX (width=', W, ', height=', H, ', viewBox=', ViewBox, |
168 | | ') cannot be applied to an existing SVG file (use VISB_SVG_CONTENTS for file or put info into SVG file): '],Msg), |
169 | | add_warning(visb_visualiser,Msg,SvgFile,Pos), |
170 | | fail. |
171 | | static_check_visb. |
172 | | |
173 | | svg_id_exists(SVGID) :- visb_svg_object(SVGID,_,_StaticAttrList,_,_ExitPos). |
174 | | % -------------------------- |
175 | | |
176 | | :- use_module(probsrc(tools),[read_string_from_file/2]). |
177 | | |
178 | | % store templates as facts, so that compiled version of probcli does not need to find files |
179 | | :- dynamic visb_template_file_codes/2. |
180 | | |
181 | | assert_from_template(Filename) :- %formatsilent('Loading ~w~n',[Filename]), |
182 | | absolute_file_name(visbsrc(Filename), Absolute, []), |
183 | | read_string_from_file(Absolute,String), |
184 | | assertz(visb_template_file_codes(Filename,String)). |
185 | | |
186 | | :- assert_from_template('visb_template_header.html'). |
187 | | :- assert_from_template('visb_template_svg_downloads.html'). |
188 | | :- assert_from_template('visb_template_replayTrace.html'). |
189 | | :- assert_from_template('visb_template_middle.html'). |
190 | | :- assert_from_template('visb_template_footer.html'). |
191 | | |
192 | | write_visb_template(HtmlFile,Stream) :- |
193 | | visb_template_file_codes(HtmlFile,Codes), |
194 | | format(Stream,'~s~n',[Codes]). |
195 | | |
196 | | |
197 | | % -------------------------- |
198 | | |
199 | | :- use_module(probsrc(pref_definitions),[b_get_definition_string_from_spec/3]). |
200 | | get_default_visb_file(Path, Pos) :- get_default_visb_file(Path, _, Pos). |
201 | | get_default_visb_file(Path, Kind, Pos) :- bmachine_is_precompiled, |
202 | | (b_get_definition_string_from_spec('VISB_JSON_FILE', Pos, Path) |
203 | | -> Kind=json % user provided explicit path to VISB JSON file |
204 | | ; b_get_definition_string_from_spec('VISB_DEFINITIONS_FILE', Pos, Path) |
205 | | -> Kind=def % user provided explicit path to VISB DEFINITIONS file |
206 | | % TODO: in future check that file extension is compatible |
207 | | % advantage of VISB_DEFINITIONS_FILE == "File" over "File" |
208 | | % 1) visualisation can be re-loaded without re-loading machine |
209 | | % 2) can be used in TLA+ or similar |
210 | | % 3) avoid clash if definitions file itself defines empty VISB_JSON_FILE |
211 | | % 4) avoid problems with Atelier-B or other tools |
212 | | ; get_default_visb_svg_file(_,Pos) |
213 | | -> Kind=empty, Path='' % user provided SVG file path |
214 | | ; user_has_defined_visb_objects_in_defs |
215 | | -> Kind=empty, Path='' % user provided SVG object definitions |
216 | | ). |
217 | | |
218 | | user_has_defined_visb_objects :- |
219 | ? | (visb_svg_object(_,_,_,_,_) -> true % created in JSON file |
220 | | ; user_has_defined_visb_objects_in_defs). |
221 | | |
222 | | user_has_defined_visb_objects_in_defs :- |
223 | | b_sorted_b_definition_prefixed(expression,'VISB_SVG_OBJECTS',_,_). |
224 | | |
225 | | % you should do b_absolute_file_name_relative_to_main_machine |
226 | | get_default_visb_svg_file(Path, Pos) :- |
227 | | b_get_definition_string_from_spec('VISB_SVG_FILE', Pos, Path). |
228 | | |
229 | | |
230 | | % load default VISB_JSON_FILE if it is specified and not already loaded |
231 | | load_default_visb_file_if_necessary :- |
232 | | get_default_visb_file(File, Pos),!, |
233 | | (load_visb_file_if_necessary(File) -> true |
234 | | ; add_error(visb_visualiser,'Could not load VISB_JSON_FILE:',File,Pos)). |
235 | | load_default_visb_file_if_necessary :- |
236 | | (eventb_mode -> true ; add_message(visb_visualiser,'No VISB_JSON_FILE DEFINITION provided')). |
237 | | |
238 | | % -------------------------- |
239 | | % Loading a JSON VisB file: |
240 | | |
241 | | |
242 | | :- use_module(probsrc(tools), [get_filename_extension/2]). |
243 | | :- use_module(probsrc(bmachine), [ |
244 | | b_load_additional_definitions_file/1, |
245 | | b_load_additional_definitions_from_list_of_facts/1, |
246 | | b_load_additional_definitions_from_term/1 |
247 | | ]). |
248 | | load_visb_file(File) :- |
249 | | temporary_set_preference(allow_arith_operators_on_reals,true,Old), |
250 | | call_cleanup((load_visb_file1(File)), |
251 | | reset_temporary_preference(allow_arith_operators_on_reals,Old)). |
252 | | load_visb_file1(File) :- |
253 | | get_filename_extension(File,def), % a .def B definition file |
254 | | !, |
255 | | add_message(visb_visualiser,'Loading VisB DEFINITIONS from B file: ',File), |
256 | | b_load_additional_definitions_file(File), |
257 | | load_visb_file2('',File). |
258 | | load_visb_file1(File) :- load_visb_file2(File,File). |
259 | | |
260 | | load_visb_definitions_from_list_of_facts(DefFilePath, ListOfFacts) :- |
261 | | temporary_set_preference(allow_arith_operators_on_reals,true,Old), |
262 | | call_cleanup( |
263 | | (b_load_additional_definitions_from_list_of_facts(ListOfFacts), |
264 | | load_visb_file2('', DefFilePath)), |
265 | | reset_temporary_preference(allow_arith_operators_on_reals,Old)). |
266 | | |
267 | | load_visb_definitions_from_term(DefFilePath, Machine) :- |
268 | | temporary_set_preference(allow_arith_operators_on_reals,true,Old), |
269 | | call_cleanup( |
270 | | (b_load_additional_definitions_from_term(Machine), |
271 | | load_visb_file2('', DefFilePath)), |
272 | | reset_temporary_preference(allow_arith_operators_on_reals,Old)). |
273 | | |
274 | | load_visb_file2(File,OrigFileName) :- |
275 | | reset_visb, |
276 | | load_visb_from_definitions(no_inlining), % TODO: pass InlineObjects? |
277 | | start_ms_timer(T), |
278 | | (File='' % No JSON file |
279 | | -> (get_default_visb_svg_file(SvgFile,DefaultSVGPos) |
280 | | -> (SvgFile='' -> AbsFile=SvgFile % just dummy empty string provided by user |
281 | | ; b_absolute_file_name_relative_to_main_machine(SvgFile,AbsFile) |
282 | | ), |
283 | | add_visb_svg_file(SvgFile,AbsFile,'',DefaultSVGPos) |
284 | | ; check_objects_created(File) % no JSON and SVG file; check we have created objects |
285 | | ) |
286 | | ; add_visb_file(File,[]), |
287 | | stop_ms_walltimer_with_msg(T,'loading VisB file: ') |
288 | | ), |
289 | | static_check_visb, |
290 | | (OrigFileName = '' |
291 | | -> ModTime=0, ModLocTime=0 % We could get modification time of files with VISB_SVG_OBJECTS, ... DEFINITIONS |
292 | | ; file_property(OrigFileName, modify_timestamp, ModTime), |
293 | | file_property(OrigFileName, modify_localtime, ModLocTime) |
294 | | ), |
295 | | assertz(visb_file_loaded(OrigFileName,ModTime,ModLocTime)). |
296 | | |
297 | | check_objects_created(File) :- |
298 | | (visb_svg_object(_,_,_,_,_) -> true |
299 | | ; add_warning(visb_visualiser,'No VisB JSON file is specified and no VISB_SVG_OBJECTS were created:',File) |
300 | | ). |
301 | | |
302 | | load_visb_from_definitions(InlineObjects) :- |
303 | | start_ms_timer(T), |
304 | | get_svg_objects_from_definitions(InlineObjects), |
305 | | (get_SVG_BOX_definition(InlineObjects) -> true ; true), |
306 | | stop_ms_walltimer_with_msg(T,'extracting VisB infos from DEFINITIONS: '). |
307 | | |
308 | | :- use_module(library(file_systems),[file_exists/1, file_property/3]). |
309 | | %:- use_module(library(system),[now/1, datime/2]). |
310 | | load_visb_file_if_necessary(File) :- |
311 | | visb_file_loaded(File,ModTime1,_), % this file is already loaded |
312 | | (File = '' -> true |
313 | | ; file_exists(File), |
314 | | file_property(File, modify_timestamp, ModTime2), % check if it has the same time stamp |
315 | | debug_println(19,visb_json_already_loaded(File,ModTime1,ModTime2)), |
316 | | ModTime1=ModTime2 |
317 | | ), |
318 | | !. |
319 | | load_visb_file_if_necessary(File) :- load_visb_file(File). |
320 | | |
321 | | |
322 | | :- use_module(probsrc(bmachine),[set_additional_filename_as_parsing_default/3, reset_filename_parsing_default/2]). |
323 | | |
324 | | add_visb_file(File,LoadedFiles) :- member(File,LoadedFiles),!, |
325 | | add_error(visb_visualiser,'Circular inclusion of JSON files:',[File|LoadedFiles]). |
326 | | add_visb_file(File,_) :- \+ file_exists(File),!, |
327 | | add_error(visb_visualiser,'JSON file does not exist:',File), fail. |
328 | | add_visb_file(File,LoadedFiles) :- |
329 | | debug_format(19,'Loading JSON File: ~w~n',[File]), |
330 | | set_additional_filename_as_parsing_default(File,NewNr,OldNr), |
331 | | call_cleanup(add_visb_file2(File,LoadedFiles), reset_filename_parsing_default(NewNr,OldNr)). |
332 | | |
333 | | add_visb_file2(File,LoadedFiles) :- |
334 | | json_parse_file(File,json(List2),[position_infos(true),multiline_strings(true)]), |
335 | | % tools_printing:trace_print(List2),nl,nl, |
336 | | process_json(List2,File), |
337 | | !, |
338 | | (get_attr_with_pos(include,List2,JsonFileTerm,File,Pos) |
339 | | -> check_json_string(JsonFileTerm,include,Pos,JsonFile), |
340 | | absolute_file_name(JsonFile,AF,[relative_to(File)]), |
341 | | formatsilent('Including JSON file: ~w~n',[JsonFile]), |
342 | | add_visb_file(AF,[File|LoadedFiles]) |
343 | | ; true |
344 | | ), |
345 | | (LoadedFiles=[], % only check for main included file |
346 | ? | get_attr_with_pos('model-name',List2,string(ModelName),File,MPos), |
347 | | b_machine_name(Main), Main \= ModelName |
348 | | -> ajoin(['VisB JSON file expects model-name ',ModelName,' instead of: '],MMsg), |
349 | | add_warning(visb_visualiser,MMsg,Main,MPos) |
350 | | ; true |
351 | | ). |
352 | | add_visb_file2(File,_) :- |
353 | | add_error(visb_visualiser,'Unable to process JSON file:',File), |
354 | | fail. |
355 | | |
356 | | % process json content of a VisB file: |
357 | | process_json(List,JSONFile) :- visb_svg_file(_,_,_,_,_),!, % we have already determined the SVG file |
358 | | process_json2(List,JSONFile). |
359 | | process_json(List,JSONFile) :- |
360 | ? | get_attr_with_pos(svg_box,List,json(BoxList),JSONFile,Pos), |
361 | | % json([=(width,400,3-3),=(height,400,3-3)]) |
362 | ? | (get_attr(svg,List,string(SvgFile)) -> SvgFile='' ; true), % check if svg attr empty or non-existant |
363 | | force_get_attr_nr(height,BoxList,H,JSONFile), |
364 | | force_get_attr_nr(width,BoxList,W,JSONFile),!, |
365 | | (get_attr(viewBox,BoxList,string(VB)) -> ViewBox=VB ; ViewBox=''), |
366 | | add_message(visb_visualiser,'Will create empty SVG image with specified dimensions: ',H:W,Pos), |
367 | | assert_visb_empty_svg_box_height_width(H,W,ViewBox,Pos), |
368 | | process_json2(List,JSONFile). |
369 | | process_json(List,JSONFile) :- |
370 | ? | get_attr_with_pos(svg,List,FileTerm,JSONFile,Pos), |
371 | | check_json_string(FileTerm,svg,Pos,File), |
372 | | (File = '' -> get_default_visb_svg_file(SvgFile, _) |
373 | | ; get_default_visb_svg_file(SvgFile, DPos) |
374 | | -> add_message(visb_visualiser,'Overriding svg file specified in JSON file: ',File,DPos) |
375 | | ; SvgFile=File), |
376 | | !, |
377 | | absolute_file_name(SvgFile,AbsFile,[relative_to(JSONFile)]), |
378 | | add_visb_svg_file(SvgFile,AbsFile,JSONFile,Pos), |
379 | | process_json2(List,JSONFile). |
380 | | process_json(List,JSONFile) :- |
381 | | get_default_visb_svg_file(SvgFile, Pos), SvgFile \= '', |
382 | | !, |
383 | | absolute_file_name(SvgFile,AbsFile,[]), % relative to B machine?? |
384 | | add_visb_svg_file(SvgFile,AbsFile,JSONFile,Pos), |
385 | | process_json2(List,JSONFile). |
386 | | process_json(List,JSONFile) :- |
387 | | process_json2(List,JSONFile), |
388 | | (get_SVG_BOX_definition(no_inlining) -> true % TODO: pass (InlineObjects) |
389 | | ; get_attr_with_pos(svg,List,_,JSONFile,Pos) -> % File is empty |
390 | | add_message(visb_visualiser,'Creating empty SVG image. You can add a declaration like "svg_box": {"width":W,"height":H} to specify dimensions in: ',JSONFile,Pos) |
391 | | ; add_warning(visb_visualiser,'Creating empty SVG image. The JSON file contains no svg attribute (pointing to the SVG file): ',JSONFile) |
392 | | ). |
393 | | |
394 | | add_visb_svg_file(SvgFile,AbsFile,JSONFile,Pos) :- |
395 | | (SvgFile='' -> add_message(visb_visualiser,'Empty VisB SVG file:',SvgFile,Pos) |
396 | | ; file_exists(AbsFile) |
397 | | -> debug_format(19,'SVG file = ~w (~w)~n',[SvgFile, AbsFile]), |
398 | | file_property(AbsFile, modify_localtime, ModLocTime) |
399 | | ; add_error(visb_visualiser,'The specified VisB SVG file does not exist:',SvgFile,Pos), |
400 | | ModLocTime=unknown |
401 | | ), |
402 | | assertz(visb_svg_file(SvgFile,AbsFile,JSONFile,Pos,ModLocTime)). |
403 | | |
404 | | process_json2(List,JSONFile) :- |
405 | | process_json_definitions(List,JSONFile), |
406 | | process_json_items(List,JSONFile), |
407 | | process_json_events(List,JSONFile), |
408 | | process_json_new_svg_objects(List,JSONFile). |
409 | | |
410 | | :- use_module(probsrc(tools_strings),[ajoin/2]). |
411 | | check_json_string(Term,_,_,Atom) :- Term = string(Atom), atom(Atom), !. |
412 | | check_json_string(Term,Attr,Pos,_) :- !, |
413 | | ajoin(['Illegal JSON attribute ',Attr,', expected a JSON string:'],Msg), |
414 | | add_error(visb_visualiser,Msg,Term,Pos),fail. |
415 | | % ---------------- |
416 | | |
417 | | % B definitions that can help write items, events more compactly |
418 | | process_json_definitions(List,File) :- |
419 | ? | get_attr(definitions,List,array(Defs)),!, |
420 | | length(Defs,Len), |
421 | | formatsilent('VisB Definitions: ~w~n',[Len]), |
422 | | maplist(process_json_definition(File),Defs). |
423 | | process_json_definitions(_,_File). |
424 | | |
425 | | % VisB items which modify attributes of SVG objects |
426 | | process_json_items(List,File) :- |
427 | ? | get_attr(items,List,array(Items)),!, |
428 | | length(Items,Len), |
429 | | formatsilent('VisB Item declarations: ~w~n',[Len]), |
430 | | maplist(process_visb_json_item(File),Items). |
431 | | process_json_items(_,File) :- \+ visb_special_definition(visb_updates,_,_,_,_,_),!, |
432 | | add_message(visb_visualiser,'The JSON file contains no items: ',File). |
433 | | process_json_items(_,_). |
434 | | |
435 | | % VisB events which react to clicks on SVG objects and display hovers |
436 | | process_json_events(List,File) :- |
437 | | get_attr(events,List,array(Items)),!, |
438 | | length(Items,Len), |
439 | | formatsilent('VisB Event declarations: ~w~n',[Len]), |
440 | | maplist(process_json_event(File),Items). |
441 | | process_json_events(_,_). |
442 | | |
443 | | % VisB additional SVG objects added to SVG file |
444 | | process_json_new_svg_objects(List,File) :- |
445 | ? | get_attr(svg_objects,List,array(Items)),!, |
446 | | length(Items,Len), |
447 | | formatsilent('VisB additional svg_objects declarations: ~w~n',[Len]), |
448 | | maplist(process_json_svg_object(File),Items). |
449 | | process_json_new_svg_objects(List,File) :- |
450 | | get_attr_with_pos(objects,List,array(Items),File,Pos),!, |
451 | | add_warning(visb_visualiser,'Use "svg_objects" attribute instead of "objects" in: ',File,Pos), |
452 | | maplist(process_json_svg_object(File),Items). |
453 | | process_json_new_svg_objects(_,_). |
454 | | |
455 | | :- use_module(probsrc(custom_explicit_sets),[try_expand_custom_set_with_catch/3, |
456 | | is_custom_explicit_set/1, is_set_value/2]). |
457 | | % evaluate all VISB_SVG_OBJECTS... DEFINITIONS and try and extract SVG objects |
458 | | % this must be a set of records with at least id and svg_class field |
459 | | get_svg_objects_from_definitions(InlineObjects) :- |
460 | ? | find_and_eval_visb_DEFINITION('VISB_SVG_OBJECTS', SVG_ID, AttrList, Desc, DefName, |
461 | | DefPos,InlineObjects,allow_separation), |
462 | | add_visb_object_from_definition(visb_objects, SVG_ID, AttrList, Desc, DefName, DefPos), |
463 | | %formatsilent('Generating new SVG object ~w with class ~w and attrs ~w~n',[SVG_ID,SVG_Class,AttrList2]), |
464 | | fail. |
465 | | get_svg_objects_from_definitions(InlineObjects) :- |
466 | | find_and_eval_visb_DEFINITION('VISB_SVG_EVENTS', SVG_ID, AttrList, Desc, DefName, |
467 | | DefPos,InlineObjects,no_separation), |
468 | | add_visb_object_from_definition(visb_events, SVG_ID, AttrList, Desc, DefName, DefPos), |
469 | | fail. |
470 | | get_svg_objects_from_definitions(InlineObjects) :- |
471 | ? | find_and_eval_visb_DEFINITION('VISB_SVG_HOVERS', SVG_ID, AttrList, Desc, DefName, |
472 | | DefPos,InlineObjects,no_separation), |
473 | | add_visb_hovers_from_definition(SVG_ID, AttrList, Desc, DefName, DefPos), |
474 | | fail. |
475 | | get_svg_objects_from_definitions(_InlineObjects) :- precompile_svg_object_updates. |
476 | | |
477 | | % a hovers field can be something like: |
478 | | % rec(.... hovers: (rec(class:"train-hover"),rec(trigger_id:"track_polyline",class:"train-hover")), ...) |
479 | | add_visb_hovers_from_definition(SVG_ID,AttrList, Desc, DefName, DefPos) :- |
480 | | select(svg_attribute(hovers,Hovers),AttrList,AttrList2), |
481 | | !, |
482 | | (AttrList2=[] -> true ; add_warning(visb_visualiser,'Unknown extra hover attributes:',AttrList2,DefPos)), |
483 | | flex_member(Record,Hovers,DefName,DefPos), |
484 | | (get_VISB_record_fields(Record,Fields) -> true |
485 | | ; add_warning(visb_visualiser,'VisB hovers field value is not a record of SVG attributes: ',Record,DefPos),fail), |
486 | | include_maplist(extract_attribute_from_record(DefPos),Fields,HoverAttrList), |
487 | | add_visb_object_from_definition(visb_hovers, SVG_ID, HoverAttrList, Desc, DefName, DefPos). |
488 | | |
489 | | add_visb_hovers_from_definition(SVG_ID,AttrList, Desc, DefName, DefPos) :- |
490 | | add_visb_object_from_definition(visb_hovers, SVG_ID, AttrList, Desc, DefName, DefPos). |
491 | | |
492 | | |
493 | | % add a VisB record object from a HOVER or OBJECT definition: |
494 | | add_visb_object_from_definition(visb_objects,SVG_ID, AttrList, Desc, DefName, DefPos) :- !, |
495 | ? | (select(svg_attribute(svg_class,SVG_Class),AttrList,AttrList2) |
496 | | -> true % maybe we should call svg_class svg_shape and |
497 | | % allow html_tag for children of foreignObject |
498 | | ; add_warning(visb_visualiser,'SVG objects have no svg_class field:',DefName,DefPos), |
499 | | fail |
500 | | ), |
501 | | assert_visb_svg_object(SVG_ID,SVG_Class,AttrList2,Desc,DefPos). |
502 | | add_visb_object_from_definition(visb_hovers,SVG_ID, AttrList, _Desc, _DefName, DefPos) :- |
503 | | (select(svg_attribute(trigger_id,TriggerID),AttrList,AttrList2) -> true |
504 | | ; select(svg_attribute('trigger-id',TriggerID),AttrList,AttrList2) -> true |
505 | | ; TriggerID = SVG_ID, AttrList2=AttrList), |
506 | | member(svg_attribute(Attr,EnterVal),AttrList2), |
507 | | (visb_svg_object(SVG_ID,_,StaticAttrList,_,ExitPos) |
508 | | -> (member(svg_attribute(Attr,ExitVal),StaticAttrList) -> true |
509 | | ; default_attribute_value(Attr,ExitVal) |
510 | | -> add_message(visb_visualiser,'Assuming default hover exit value for attribute: ',Attr,DefPos) |
511 | | ; Attr = 'svg_class' |
512 | | -> add_warning(visb_visualiser, |
513 | | 'svg_class cannot be set in hover for: ',SVG_ID,ExitPos), |
514 | | ExitVal=EnterVal |
515 | | ; add_warning(visb_visualiser, |
516 | | 'No static (exit) value can be retrieved for hover for attribute: ',Attr,ExitPos), |
517 | | ExitVal=EnterVal |
518 | | ) |
519 | | ; ajoin(['No VISB_SVG_OBJECT for id ',SVG_ID,', cannot retrieve hover exit value for attribute: '],Msg), |
520 | | add_warning(visb_visualiser,Msg,Attr,DefPos), |
521 | | fail %ExitVal=EnterVal |
522 | | ), |
523 | | assert_visb_hover(TriggerID,SVG_ID,Attr,EnterVal,ExitVal,DefPos). |
524 | | add_visb_object_from_definition(visb_events,SVG_ID, AttrList, _Desc, DefName, DefPos) :- !, |
525 | | ( select(svg_attribute(event,Event),AttrList,AttrList1) -> true |
526 | | ; select(svg_attribute(events,Events),AttrList,AttrList1) -> % we have events attributes with multiple events |
527 | | flex_member(EvVal,Events,DefName,DefPos), |
528 | | extract_attr_value(event,EvVal,Event,DefPos) |
529 | | ; AttrList = [_|_], % at least one other attribute than id; otherwise it may stem from separating VISB_SVG_OBJECTS |
530 | | add_warning(visb_visualiser,'Missing event attribute in VisB definition: ',DefName,DefPos), |
531 | | fail |
532 | | ), |
533 | | (select(svg_attribute(predicate,Pred),AttrList1,_AttrList2) -> Preds=[Pred] |
534 | | ; member(P,[preds,predicates]), |
535 | | select(svg_attribute(P,Pred),AttrList1,_AttrList2) |
536 | | -> Preds=[Pred], add_warning(visb_visualiser,'Use predicate as attribute for VisB events instead of: ',P,DefPos) |
537 | | ; Preds=[] %, AttrList2=AttrList1 |
538 | | ), |
539 | | EnableItems=[], |
540 | | % TODO extract from AttrList2: visb_enable_item(SvgID,Attr,EnabledValExpr,DisabledValExpr,PosAttr) |
541 | | (error_manager:extract_file_number_and_name(DefPos,_,File) -> true ; File='?'), |
542 | | add_visb_event(SVG_ID,Event,Preds,[],EnableItems,File,DefPos,[]). |
543 | | |
544 | | default_attribute_value(fill,black). % is remove for animate, ... |
545 | | default_attribute_value(opacity,1). |
546 | | default_attribute_value('stop-dasharray',none). |
547 | | default_attribute_value('stop-opacity',1). |
548 | | default_attribute_value('stroke-opacity',1). |
549 | | default_attribute_value('stroke-width','1px'). |
550 | | default_attribute_value(stroke,none). |
551 | | default_attribute_value(transform,none). |
552 | | default_attribute_value(visibility,visible). |
553 | | |
554 | | % is called in process_json when no SVG file specified |
555 | | % VISB_SVG_BOX == rec(width:1000,height:1000,viewBox:"minx miny w h"), |
556 | | get_SVG_BOX_definition(InlineObjects) :- |
557 | ? | get_and_eval_special_definition('VISB_SVG_BOX','VISB_SVG_BOX',visb_box,DefPos,ResValue,InlineObjects), |
558 | | (ResValue=(BH,BW) -> ViewBox='' |
559 | | ; get_VISB_record_fields(ResValue,Fields), |
560 | ? | select(field(height,BH),Fields,F1), |
561 | ? | select(field(width,BW),F1,F2) |
562 | | -> (select(field(viewBox,VBVal),F2,F3) |
563 | | -> (VBVal=string(VB) -> ViewBox=VB |
564 | | % Viewbox is "mx my w h" string, ie: minimum_x, minimum_y, width and height |
565 | | ; VBVal = rec(VBFields) |
566 | | -> (get_view_box_rec(VBFields,DefPos,ViewBox) -> true |
567 | | ; ViewBox='', |
568 | | add_warning(visb_visualiser,'VISB_SVG_BOX viewBox record illegal fields (expected minx miny width height):',VBVal,DefPos)) |
569 | | ; add_warning(visb_visualiser,'VISB_SVG_BOX viewBox is not a string ("minx miny width height") or record:',VBVal,DefPos), |
570 | | ViewBox='' |
571 | | ) |
572 | | ; ViewBox='', F3=F2 |
573 | | ), |
574 | | (F3=[] -> true |
575 | | ; add_warning(visb_visualiser,'VISB_SVG_BOX unknown attributes (not height, width, viewBox): ',F2,DefPos)) |
576 | | ; add_error(visb_visualiser,'Ignoring VISB_SVG_BOX, must be record or pair of integers (height,width):',ResValue,DefPos)), |
577 | | (get_number_from_bvalue(BH,H) -> true |
578 | | ; add_error(visb_visualiser,'VISB_SVG_BOX Height is not a number:',ResValue,DefPos)), |
579 | | (get_number_from_bvalue(BW,W) -> true |
580 | | ; add_error(visb_visualiser,'VISB_SVG_BOX Width is not a number:',ResValue,DefPos)), |
581 | | !, |
582 | | assert_visb_empty_svg_box_height_width(H,W,ViewBox,DefPos). |
583 | | |
584 | | get_view_box_rec([field(height,VH),field(minx,MXH),field(miny,MYH),field(width,VW)],DefPos,ViewBoxString) :- |
585 | | (get_number_from_bvalue(VH,Height) -> true |
586 | | ; add_error('VISB_SVG_BOX viewBox\'height is not a number:',VH,DefPos),fail), |
587 | | (get_number_from_bvalue(VW,Width) -> true |
588 | | ; add_error('VISB_SVG_BOX viewBox\'width is not a number:',VH,DefPos),fail), |
589 | | (get_number_from_bvalue(MXH,MinX) -> true |
590 | | ; add_error('VISB_SVG_BOX viewBox\'minx is not a number:',VH,DefPos),fail), |
591 | | (get_number_from_bvalue(MYH,MinY) -> true |
592 | | ; add_error('VISB_SVG_BOX viewBox\'miny is not a number:',VH,DefPos),fail), |
593 | | ajoin([MinX,' ',MinY,' ', Width,' ',Height],ViewBoxString). |
594 | | |
595 | | |
596 | | assert_visb_empty_svg_box_height_width(H,W,_ViewBox,Pos) :- |
597 | | retract(visb_empty_svg_box_height_width(OldH,OldW,_)), |
598 | | (OldH,OldW) \= (H,W), |
599 | | add_message(visb_visualiser,'Overriding VisB SVG_BOX default dimensions: ',(OldH,OldW),Pos), |
600 | | fail. |
601 | | assert_visb_empty_svg_box_height_width(H,W,ViewBox,_Pos) :- |
602 | | %add_message(visb_visualiser,'Setting VisB SVG_BOX default dimensions: ',(H,W,ViewBox),Pos), |
603 | | assert(visb_empty_svg_box_height_width(H,W,ViewBox)). |
604 | | |
605 | | :- use_module(probsrc(bsyntaxtree), [get_texpr_pos/2]). |
606 | | :- use_module(probsrc(bmachine),[b_sorted_b_definition_prefixed/4, b_get_typed_definition/3]). |
607 | | % find DEFINITION with given prefix in name, evaluate it and return SVG_ID and attribute list: |
608 | | % AllowSep = allow_seperation means that the record fields can be separated into static objects and dynamic updates |
609 | | % and only static ones will be retained (dynamic ones dealt with later) |
610 | | find_and_eval_visb_DEFINITION(DEFPREFIX, SVG_ID, AttrList,Desc, DefName, DefPos,InlineObjects,AllowSep) :- |
611 | | ( b_sorted_b_definition_prefixed(expression,DEFPREFIX,DefName,DefPos), |
612 | ? | if(b_get_typed_definition(DefName,[variables_and_additional_defs],Body),true, |
613 | | (add_message(visb_visualiser,'Ignoring VisB DEFINITION due to errors: ',DefName),fail)), |
614 | | Kind=unknown |
615 | | ; special_backup(DEFPREFIX,Kind), |
616 | | % also look at stored definitions (e.g., from static/dynamic separation of VISB_SVG_OBJECTS) |
617 | | visb_special_definition(Kind,DefName,_Type,Body,_Class,DefPos) |
618 | | ), |
619 | | set_error_context(visb_error_context(definition,DefName,'all_attributes',DefPos)), |
620 | ? | call_cleanup((get_typed_static_definition_with_constants_state(DefName,Body, |
621 | | ResBody,DefPos,ConstState,InlineObjects,AllowSep), |
622 | | get_visb_DEFINITION_svg_object(Kind,DefName,ResBody,DefPos,ConstState,SVG_ID,AttrList,Desc)), |
623 | | clear_error_context). |
624 | | |
625 | | special_backup('VISB_SVG_HOVERS',visb_hovers). |
626 | | |
627 | | % evaluate a typed body expressions evaluating to a record or set of records |
628 | | % and translate into SVG attribute lists: |
629 | | get_visb_static_svg_object_for_typed_expr(Kind,DefName,Body,DefPos,SVG_ID,AttrList,Desc) :- |
630 | | AllowSep=no_separation, |
631 | | Inline=no_inlining, |
632 | | get_typed_static_definition_with_constants_state(DefName,Body,ResBody,DefPos,ConstState,Inline,AllowSep), |
633 | | get_visb_DEFINITION_svg_object(Kind,DefName,ResBody,DefPos,ConstState,SVG_ID,AttrList,Desc). |
634 | | |
635 | | |
636 | | flatten_couple(b(couple(A,B),_,_)) --> !,flatten_couple(A),flatten_couple(B). |
637 | | % we could also flatten union(A,B), but at the risk of duplicate warnings when the same element occurs in A and B |
638 | | flatten_couple(A) --> [A]. |
639 | | |
640 | | get_typed_static_definition_with_constants_state(DefName,Body,ResBody,DefPos,ConstantsState,InlineObjects,AllowSep) :- |
641 | | flatten_couple(Body,TupleList,[]), |
642 | | % the VISB_SVG_OBJECT definition may consist of a tuple (Obj1,Obj2,...) to allow grouping |
643 | | (TupleList = [_,_|_] |
644 | | -> add_debug_message(visb_visualiser,'Decomposed VisB definition body tuple:',DefName,DefPos) |
645 | | ; true), |
646 | ? | nth1(DefNr,TupleList,TupleBody), |
647 | | (get_texpr_pos(TupleBody,TuplePos) -> true ; TuplePos=DefPos), |
648 | | get_typed_static_definition_with_constants_state3(DefName,DefNr,TupleBody,ResBody,TuplePos, |
649 | | ConstantsState,InlineObjects,AllowSep). |
650 | | get_typed_static_definition_with_constants_state3(DefName,DefNr,Body,ResBody,DefPos,ConstantsState,InlineObjects,AllowSep) :- |
651 | | determine_type_of_visb_formula(Body,TIds,Class), |
652 | | debug_format(19,'Detected VisB DEFINITION ~w (~w)~n',[DefName,Class]), |
653 | | (%Class=requires_variables, % now also useful if event field present |
654 | | AllowSep=allow_separation, % allowed for VISB_SVG_OBJECTS |
655 | ? | if(separate_into_static_and_dynamic_part(DefName,DefNr,Body,StaticBody,DynamicBody,EventBody,HoverBody), |
656 | | true, |
657 | | (get_texpr_type(Body,Type), |
658 | | (contains_events_or_hovers_field(Type) |
659 | | -> add_warning(visb_visualiser,'Static/Dynamic separation failed for (required for events or hovers): ',DefName,DefPos) |
660 | | % VISB_SVG_OBJECT definition contains events/hovers and as such requires separation; which failed here |
661 | | ; add_debug_message(visb_visualiser,'Static/Dynamic separation failed or not useful for: ',DefName,DefPos) |
662 | | ), |
663 | | fail)), |
664 | | determine_type_of_visb_formula(StaticBody,SIds,SClass), |
665 | | get_unique_initial_state_for_visb(SClass,DefName,DefPos,SIds,ConstantsState) |
666 | | -> Separated=true, ResBody=StaticBody, |
667 | | add_debug_message(visb_visualiser,'Automatically separated fields into static and dynamic: ',DefName,DefPos), |
668 | | %write('STATIC: '),translate:print_bexpr(StaticBody),nl, write('DYNAMIC: '),translate:print_bexpr(DynamicBody),nl, |
669 | | assert_visb_udpate_def_body(visb_updates,DefName,DynamicBody,DefPos), |
670 | | add_visb_events_from_def_body(visb_events,DefName,EventBody,DefPos), |
671 | | assert_visb_udpate_def_body(visb_hovers,DefName,HoverBody,DefPos) % needs to be asserted so that it can be evaluated after svg objects have been created to extract exit value |
672 | | ; get_unique_initial_state_for_visb(Class,DefName,DefPos,TIds,ConstantsState) |
673 | | -> ResBody=Body |
674 | | ; ResBody=Body, |
675 | | (Class=requires_constants -> |
676 | | get_texpr_ids(TIds,Ids), |
677 | | % we could check if values of Ids are identical in all constants solutions |
678 | | (is_concrete_constants_state_id(_) |
679 | | -> BMsg='multiple solutions for used constants exist: ' |
680 | | ; BMsg='but no constants were found or setup yet: ' |
681 | | ), |
682 | | ajoin(['DEFINITION ',DefName, ' requires constants but ',BMsg],Msg), |
683 | | (get_a_constants_state(ConstantsState,StateID,InlineObjects) |
684 | | -> (member(CstID,Ids), |
685 | | other_constant_value_exists_for(CstID,ConstantsState,StateID) |
686 | | -> add_warning(visb_visualiser,Msg,CstID,DefPos) |
687 | | ; ajoin(['DEFINITION ',DefName, |
688 | | ' requires constants and all SETUP_CONSTANTS solutions have same value thus far: '],Msg2), |
689 | | % constraint-based checks or execute by predicate could later create others ! |
690 | | add_message(visb_visualiser,Msg2,Ids,DefPos) |
691 | | ) |
692 | | ; add_error(visb_visualiser,Msg,Ids,DefPos), ConstantsState=[] |
693 | | ) |
694 | | ; ConstantsState=[] |
695 | | ) |
696 | | ), |
697 | | (Class=requires_variables, Separated=false |
698 | | -> get_texpr_ids(TIds,AIds), |
699 | | include(b_is_variable,AIds,VIds), |
700 | | ajoin_with_sep(VIds,',',SVids), |
701 | | (get_preference(visb_allow_variables_for_objects,false) |
702 | | -> ajoin(['Ignoring DEFINITION which requires variables ',SVids,': '],WMsg), |
703 | | add_warning(visb_visualiser,WMsg,DefName,DefPos),fail |
704 | | ; ConstantsState=[] |
705 | | -> add_warning(visb_visualiser,'Ignoring DEFINITION which requires variables, could not find unique initial state: ',DefName,DefPos),fail |
706 | | ; ajoin(['DEFINITION requires variables ',SVids, |
707 | | '; exporting history to HTML may not work correctly: '],WMsg), |
708 | | add_message(visb_visualiser,WMsg,DefName,DefPos) |
709 | | ) |
710 | | ; true). |
711 | | |
712 | | |
713 | | :- use_module(probsrc(bsyntaxtree), [create_couple/2, create_couple/3]). |
714 | | % separate/split/filter VISB_SVG_OBJECTS definitions into a static part and a dynamic part depending on variables |
715 | | % (aka updates/items) |
716 | | separate_into_static_and_dynamic_part(DefName,DefNr,Body,StaticBody,DynamicBody,EventBody,HoverBody) :- |
717 | ? | separate_static_dyn_aux(DefName,DefNr,[],[],Body,StaticBody,DynamicBody,EventBody,HoverBody). |
718 | | |
719 | | separate_static_dyn_aux(DefName,DefNr,OuterQuantifiedIds,Path,b(couple(A,B),_,_Info), |
720 | | StaticCouple,DynamicCouple,EventCouple,HoverCouple) :- !, |
721 | | separate_static_dyn_aux(DefName,DefNr,OuterQuantifiedIds,[0|Path],A,SA,DA,EA,HA), |
722 | | separate_static_dyn_aux(DefName,DefNr,OuterQuantifiedIds,[1|Path],B,SB,DB,EB,HB), |
723 | | create_couple(SA,SB,StaticCouple), |
724 | | create_couple(DA,DB,DynamicCouple), |
725 | | create_couple(EA,EB,EventCouple), |
726 | | create_couple(HA,HB,HoverCouple). |
727 | | separate_static_dyn_aux(DefName,DefNr,OuterQuantifiedIds,Path,TExpr, |
728 | | b(StaticSetComp,set(ST),I), |
729 | | b(DynamicSetComp,set(DT),I), |
730 | | b(EventsSetComp,set(ET),I), |
731 | | b(HoversSetComp,set(HT),I)) :- |
732 | ? | bsyntaxtree:is_eventb_comprehension_set(TExpr,Ids,Pred,Expr), |
733 | | (OuterQuantifiedIds = [] |
734 | | -> add_debug_message(visb_visualiser,'Top-level set comprehensions for VISB: ',Ids,TExpr) |
735 | | ; add_message(visb_visualiser,'Nested set comprehensions for VISB: ',OuterQuantifiedIds,TExpr) |
736 | | ), |
737 | | !, |
738 | | determine_type_of_visb_formula(b(exists(Ids,Pred),pred,[]),SIds,Class), |
739 | | (get_unique_initial_state_for_visb(Class,DefName,Pred,SIds,_) |
740 | | -> true % The predicate must be statically executable |
741 | | ; add_message(visb_visualiser,'Cannot statically evaluate comprehension set domain: ',Pred,Pred), |
742 | | % at the moment we require the domain to be computable statically for both static/dynamic attributes |
743 | | fail |
744 | | ), |
745 | | append(OuterQuantifiedIds,Ids,NewOuterQuantifiedIds), |
746 | ? | separate_static_dyn_aux(DefName,DefNr,NewOuterQuantifiedIds,Path,Expr, |
747 | | StaticRec,DynamicRec,EventRec,HoverRec), |
748 | | get_texpr_type(StaticRec,ST), |
749 | | get_texpr_type(DynamicRec,DT), |
750 | | get_texpr_type(EventRec,ET), |
751 | | get_texpr_type(HoverRec,HT), |
752 | | bsyntaxtree:get_texpr_info(TExpr,I), |
753 | | b_ast_cleanup:rewrite_event_b_comprehension_set(Ids,StaticRec,Pred, set(ST), StaticSetComp), |
754 | | b_ast_cleanup:rewrite_event_b_comprehension_set(Ids,DynamicRec,Pred,set(DT), DynamicSetComp), |
755 | | b_ast_cleanup:rewrite_event_b_comprehension_set(Ids,EventRec,Pred,set(ET), EventsSetComp), |
756 | | b_ast_cleanup:rewrite_event_b_comprehension_set(Ids,HoverRec,Pred,set(HT), HoversSetComp). |
757 | | separate_static_dyn_aux(DefName,DefNr,OuterQuantifiedIds,Path,b(rec(Fields),_,Info), |
758 | | b(rec(StaticFields),record(SFT),Info), % VISB_OBJECTS (static) |
759 | | b(UpdateRecWithDynamicFields,record(DFT),Info), % VISB_UPDATES (dynamic) |
760 | | b(rec(AllEventFields),record(EFT),Info), % VISB_EVENTS |
761 | | b(rec(AllHoverFields),record(HFT),Info) % VISB_HOVERS |
762 | | ) :- !, |
763 | | split_list(is_visb_event_field,Fields,EventFields,ObjectAndHoverFields), |
764 | | (select(field(hovers,HoverRec),ObjectAndHoverFields,ObjectFields) |
765 | | -> HoverFields = [field(hovers,HoverRec)] % record deconstructed in add_visb_hovers_from_definition |
766 | | ; ObjectFields=ObjectAndHoverFields, HoverFields = []), |
767 | | % maplist(check_field_is_supported(Info),ObjectFields), % will lead to duplicate warning messages, check_visb_update_type e.g., will be called for dynamic updates |
768 | | separate_fields(ObjectFields,StaticFields0,DynamicFields,DefName), |
769 | ? | (member(field(svg_class,_SVG_Class),StaticFields0) -> true |
770 | | ; member(field(svg_class,SVG_Class),DynamicFields) |
771 | | -> add_warning(visb_visualiser,'SVG svg_class field is not static in: ',DefName,SVG_Class), |
772 | | fail |
773 | | ; add_warning(visb_visualiser,'No svg_class field in: ',DefName,Info), |
774 | | fail |
775 | | ), |
776 | ? | (member(field(id,SVGID),StaticFields0) |
777 | | -> (DynamicFields \= [] ; EventFields \= [] ; HoverFields \= [] % separation is useful for this record |
778 | | ; Path \= [] % we are part of a couple; maybe other records have a dynamic,event or hover part; so proceed |
779 | | ), |
780 | | StaticFields = StaticFields0, |
781 | | TStatic_SVGID = SVGID |
782 | | ; member(field(id,SVGID),DynamicFields) |
783 | | -> add_warning(visb_visualiser,'SVG id field is not static in: ',DefName,SVGID), |
784 | | fail |
785 | | ; OuterQuantifiedIds = [] |
786 | | -> gensym(svg_id,GenID), |
787 | | ajoin(['Generated id ',GenID, ' for SVG object without id field in: '],Msg), |
788 | | add_debug_message(visb_visualiser,Msg,DefName,Info), |
789 | | SVGID = b(string(GenID),string,[]), |
790 | | sort([field(id,SVGID) | StaticFields0],StaticFields) |
791 | | ; % the record is quantified within a set comprehension; we need to compute the ID from OuterQuantifiedIds |
792 | | % it has to be identical for VISB_SVG_OBJECTS and VISB_SVG_UPDATES |
793 | | SVGID = b(ExtFunCall,string,[]), |
794 | | convert_path_to_int(Path,IntPath), |
795 | | PathExpr = b(integer(IntPath),set(integer),[]), |
796 | | create_couple([b(string(DefName),string,[]),b(integer(DefNr),integer,[]),PathExpr|OuterQuantifiedIds],Tuple), |
797 | | % add DefName and DefNr to avoid clash if other Definition has same quantified ids |
798 | | ExtFunCall = external_function_call('SHA_HASH_HEX',[Tuple]), |
799 | | add_debug_message(visb_visualiser,'Generated SHA_HASH_HEX call for id of SVG objects without id field in: ',DefName,Info), |
800 | | sort([field(id,SVGID) | StaticFields0],StaticFields) |
801 | | ), |
802 | | maplist(get_field_type,StaticFields,SFT), |
803 | | ( (select(field(visibility,VisibExpr),DynamicFields,RestDynamicFields) |
804 | | ; member(field(visibility,VisibExpr),StaticFields0), % the visibility expression is static |
805 | | RestDynamicFields = DynamicFields |
806 | | ), |
807 | | RestDynamicFields = [_|_], |
808 | | \+ hovers_can_set_visibility(HoverFields), |
809 | | (nonvar(TStatic_SVGID), TStatic_SVGID = b(string(Static_SVGID),_,_) % TODO: evaluate properly |
810 | | -> \+ visb_has_visibility_hover(Static_SVGID) % TODO: check no other hover definition added later |
811 | | ; true) % the ID is generated and cannot be accessed by other hovers which could make object visible |
812 | | -> % create IF-THEN-ELSE to avoid evaluating fields when object not visible; also fixes WD issues |
813 | | TRUE = b(boolean_true,boolean,[]), |
814 | | sort([field(id,SVGID),field(visibility,TRUE)|RestDynamicFields],AllDynamicFields), |
815 | | maplist(construct_dummy_value,RestDynamicFields,RestDummyFields), |
816 | | sort([field(id,SVGID),field(visibility,b(boolean_false,boolean,[]))|RestDummyFields],AllDummyFields), |
817 | | create_visibility_check(VisibExpr,VisibilityCond), |
818 | | UpdateRecWithDynamicFields = if_then_else(VisibilityCond, |
819 | | b(rec(AllDynamicFields),record(DFT),Info), |
820 | | b(rec(AllDummyFields),record(DFT),Info)), |
821 | | add_debug_message(visb_visualiser,'Refactoring VisB Record with visibility attribute: ',VisibilityCond) |
822 | | % ,translate:print_bexpr(b(UpdateRecWithDynamicFields,any,[])),nl |
823 | | ; sort([field(id,SVGID)|DynamicFields],AllDynamicFields), % TODO: use kernel_records |
824 | | UpdateRecWithDynamicFields = rec(AllDynamicFields) |
825 | | ), |
826 | | maplist(get_field_type,AllDynamicFields,DFT), |
827 | | sort([field(id,SVGID)|EventFields],AllEventFields), % ditto |
828 | | maplist(get_field_type,AllEventFields,EFT), |
829 | | sort([field(id,SVGID)|HoverFields],AllHoverFields), % ditto |
830 | | maplist(get_field_type,AllHoverFields,HFT). |
831 | | separate_static_dyn_aux(DefName,DefNr,OuterQuantifiedIds,_Path,TEXPR, _, _, _,_) :- |
832 | | ajoin(['Uncovered expression for ',DefName,'-',DefNr,' ',OuterQuantifiedIds],Msg), |
833 | | add_debug_message(visb_visualiser,Msg,TEXPR,TEXPR),fail. |
834 | | |
835 | | hovers_can_set_visibility(HoverFields) :- member(field(hovers,Expr),HoverFields), |
836 | | hover_expr_can_set_visibility(Expr). |
837 | | |
838 | | hover_expr_can_set_visibility(b(E,_,_)) :- hovers_can_set_visib_aux(E). |
839 | | hovers_can_set_visib_aux(couple(A,B)) :- !, (hover_expr_can_set_visibility(A) ; hover_expr_can_set_visibility(B)). |
840 | | hovers_can_set_visib_aux(rec(Fields)) :- !, member(field(visibility,_),Fields). |
841 | | hovers_can_set_visib_aux(set_extension(L)) :- !, member(E,L), hover_expr_can_set_visibility(E). |
842 | | hovers_can_set_visib_aux(E) :- write(assume_hover_can_set_visibility(E)),nl. |
843 | | % TODO: synchronise with flex_expand and check we cover all relevant cases like partial functions |
844 | | |
845 | | :- use_module(probsrc(bsyntaxtree), [create_equality/3]). |
846 | | create_visibility_check(VisibExpr,VisibilityCond) :- get_texpr_type(VisibExpr,string),!, |
847 | | VISIBLE = b(string('visible'),string,[]), |
848 | | create_equality(VisibExpr,VISIBLE,VisibilityCond). |
849 | | create_visibility_check(VisibExpr,VisibilityCond) :- |
850 | | TRUE = b(boolean_true,boolean,[]), |
851 | | create_equality(VisibExpr,TRUE,VisibilityCond). |
852 | | |
853 | | :- use_module(probsrc(typing_tools),[any_value_for_type/2]). |
854 | | construct_dummy_value(field(Name,TExpr),field(Name,b(value(DummyValue),Type,[]))) :- |
855 | | get_texpr_type(TExpr,Type), |
856 | | any_value_for_type(Type,DummyValue). % object not visible: do not evaluate expression; just produce dummy value |
857 | | |
858 | | % treat path of 0,1 as binary number |
859 | | convert_path_to_int([],0). |
860 | | convert_path_to_int([H|T],Res) :- convert_path_to_int(T,IT), |
861 | | Res is IT*2+H. |
862 | | |
863 | | % is the name of a field for events inside a VISB_SVG_OBJECT record |
864 | | is_visb_event_field(field(Name,_)) :- is_visb_event_field_name(Name). |
865 | | is_visb_event_field_name(event). |
866 | | is_visb_event_field_name(events). % tuple or set of events inside VISB_SVG_OBJECTS |
867 | | is_visb_event_field_name(predicate). |
868 | | % is the name of a field for hovers inside a VISB_SVG_OBJECT record |
869 | | %is_visb_hover_field_name(hovers). |
870 | | %is_visb_hover_field_name(items). % enable items |
871 | | %is_visb_hover_field_name(optional). % not needed ? |
872 | | %is_visb_hover_field_name(override). % not needed ? |
873 | | |
874 | | % check if the type of a VISB_SVG_OBJECTS expression requires separation for hovers/events |
875 | | contains_events_or_hovers_field(set(X)) :- contains_events_or_hovers_field(X). |
876 | | contains_events_or_hovers_field(couple(A,B)) :- |
877 | | (contains_events_or_hovers_field(A) -> true ; contains_events_or_hovers_field(B)). |
878 | | contains_events_or_hovers_field(record(F)) :- member(field(Name,_),F), |
879 | | (is_visb_event_field_name(Name) -> true ; is_visb_event_field_name(Name)). |
880 | | |
881 | | get_field_type(field(Name,Expr),field(Name,T)) :- get_texpr_type(Expr,T). |
882 | | |
883 | | % separate fields from a SVG/VISB_SVG_OBJECT record into static part and dynamic update expressions |
884 | | separate_fields([],[],[],_). |
885 | | separate_fields([field(Field,Expr)|T],[field(Field,Expr)|TS],TD,DefName) :- |
886 | | is_static_expr(Expr,Field,DefName),!, |
887 | | separate_fields(T,TS,TD,DefName). |
888 | | separate_fields([field(Field,Expr)|T],[field(Field,Default)|TS],[field(Field,Expr)|TD],DefName) :- |
889 | | requires_static_default_value(Field,Default), !, |
890 | | separate_fields(T,TS,TD,DefName). |
891 | | separate_fields([H|T],TS,[H|TD],DefName) :- |
892 | | separate_fields(T,TS,TD,DefName). |
893 | | |
894 | | % fields which require a static default value; here to set up child SVG objects of title |
895 | | % static default values could also be useful for hovers in general? |
896 | | requires_static_default_value(title,b(string('-title-not-set-'),string,[])). |
897 | | |
898 | | % virtual SVG attributes which are translated to children tags/objects |
899 | | attribute_automatically_creates_children(title). |
900 | | |
901 | | is_static_expr(Expr,Field,DefName) :- |
902 | | determine_type_of_visb_formula(Expr,_TIds,Class), % TODO pass local variables from exists above |
903 | | (Class=requires_nothing -> true |
904 | | ; Class=requires_constants, |
905 | | \+ multiple_concrete_constants_exist, % TODO: check if _TIds have multiple solutions |
906 | | is_concrete_constants_state_id(_) -> true |
907 | | ; ajoin(['Detected dynamic expression for field ',Field,' in ',DefName,': '],Msg), |
908 | | add_debug_message(visb_visualiser,Msg,Expr,Expr),fail |
909 | | ). |
910 | | |
911 | | % -------- |
912 | | |
913 | | |
914 | | extract_attribute_from_record(DefPos,field(OrigName,Value),svg_attribute(Name,SVal)) :- |
915 | | opt_rewrite_field_name(OrigName,Name), |
916 | | extract_attribute_value(DefPos,Name,Value,SVal). |
917 | | extract_attribute_from_record(DefPos,F,_) :- |
918 | | add_error(bvisualiser,'Extract SVG attribute failed: ',F,DefPos),fail. |
919 | | |
920 | | % extract a value for a particular field Name |
921 | | extract_attribute_value(DefPos,Name,Value,SVal) :- |
922 | | (deconstruct_singleton_set(Name,Value,Element) |
923 | | -> Element \= '$optional_field_absent', |
924 | | extract_attr_value(Name,Element,SVal,DefPos) |
925 | | ; extract_attr_value(Name,Value,SVal,DefPos) |
926 | | ). |
927 | | |
928 | | :- use_module(probsrc(specfile), [classical_b_mode/0]). |
929 | | |
930 | | % in TLA+ mode optional record fields have {TRUE|->VALUE} rather than VALUE |
931 | | % this can also be useful in B to allow mixing different SVG records in a set |
932 | | % for Alloy mode we may want to also support singleton sets as scalars |
933 | | deconstruct_singleton_set(Name,Set,Res) :- |
934 | | singleton_set(Set,El), |
935 | | detect_partial_records_for_field(Name), |
936 | | (El=(pred_true,El2) |
937 | | -> Val=El2 % TLA2B encoding for optional fields that are present |
938 | | ; Val=El), % Alloy |
939 | | !, |
940 | | Res = Val. |
941 | | deconstruct_singleton_set(Name,[],Res) :- |
942 | | detect_partial_records_for_field(Name), |
943 | | Res = '$optional_field_absent'. |
944 | | |
945 | | detect_partial_records_for_field(children) :- !, fail. % children field for groups is a set of ids |
946 | | detect_partial_records_for_field(Name) :- |
947 | | is_svg_number_attribute(Name),!. % sets never sensible as a numerical value |
948 | | detect_partial_records_for_field(Name) :- is_id_or_text_attribute(Name),!. % ditto for ids |
949 | | detect_partial_records_for_field(Name) :- is_svg_color_attribute(Name),!. % ditto for colors |
950 | | detect_partial_records_for_field(_) :- |
951 | | \+ classical_b_mode. % TODO: check that we are in TLA or Alloy mode? |
952 | | % TODO: ensure ProB2 sets animation minor mode for TLA |
953 | | |
954 | | :- use_module(probsrc(tools),[split_chars/3, safe_number_codes/2,safe_atom_codes/2]). |
955 | | :- use_module(extrasrc(external_functions_svg),[svg_points/4]). |
956 | | extract_attr_value(Name,Value,SVal,DefPos) :- |
957 | | is_svg_number_attribute(Name),!, % we could try and extract svg_class from attribute list above |
958 | | (get_number_from_bvalue(Value,NrVal) |
959 | | -> SVal=NrVal % convert to atom? |
960 | | ; b_value_to_string(Value,SVal), |
961 | | (is_special_svg_number_form(SVal) -> true |
962 | | ; atom_codes(SVal,CC), |
963 | | safe_number_codes(_NrVal,CC) -> true |
964 | | ; ajoin(['The value of the SVG attribute "',Name, |
965 | | '" is not a number: '],Msg), |
966 | | add_warning(visb_visualiser,Msg,SVal,DefPos) |
967 | | ) |
968 | | ). |
969 | | extract_attr_value(children,Value,SVal,DefPos) :- !, |
970 | | (is_set_value(Value,extract_attr_value) |
971 | | -> (try_expand_custom_set_with_catch(Value,ExpandedSet,extract_attr_value), |
972 | | maplist(b_value_to_id_string,ExpandedSet,SVal) -> true |
973 | | ; add_warning(visb_visualiser,'The children attribute should be a finite set of identifiers: ',Value,DefPos), |
974 | | SVal=[] |
975 | | ) |
976 | | ; add_warning(visb_visualiser,'The children attribute should be a set of identifiers: ',Value,DefPos), |
977 | | SVal=[]). |
978 | | extract_attr_value(points,Value,SVal,DefPos) :- % Class should be polygon or polyline |
979 | | % automatically translate sequences of pairs of numbers to SVG string format |
980 | | (Value = [(int(_),_)|_] ; Value = avl_set(node((int(_),_),_,_,_,_))), % TODO: check typing |
981 | | svg_points(Value,Str,DefPos,no_wf_available),!, |
982 | | string(SVal)=Str. |
983 | | extract_attr_value(points,Value,SVal,_DefPos) :- Value = [],!, SVal = ''. |
984 | | extract_attr_value(visibility,Value,SVal,DefPos) :- !, |
985 | | % convert TRUE -> visible, FALSE -> hidden |
986 | | ( Value=pred_true -> TxtVal='visible' |
987 | | ; Value=pred_false -> TxtVal='hidden' |
988 | | ; b_value_to_text_string(Value,TxtVal), |
989 | ? | (member(TxtVal,[collapse,hidden,visible]) -> true |
990 | | ; add_warning(visb_visualiser,'Value of SVG attribute "visibility" must be collapse,hidden or visible and not: ',TxtVal,DefPos)) |
991 | | ), |
992 | | SVal=TxtVal. |
993 | | extract_attr_value(Name,Value,_,DefPos) :- |
994 | | is_svg_color_attribute(Name), |
995 | | illegal_color(Value), |
996 | | ajoin(['Value of SVG attribute "',Name, |
997 | | '" is not a colour: ' ],Msg), |
998 | | add_warning(visb_visualiser,Msg,Value,DefPos),fail. |
999 | | extract_attr_value(Name,Value,SVal,_) :- |
1000 | ? | is_id_or_text_attribute(Name),!, |
1001 | | (is_text_attribute(Name) |
1002 | | -> b_value_to_text_string(Value,SVal) |
1003 | | ; b_value_to_id_string(Value,SVal)). |
1004 | | extract_attr_value(Attr,RawValue,ResValue,_DefPos) :- raw_value_attribute(Attr),!, % keep value intact |
1005 | | ResValue = RawValue. |
1006 | | extract_attr_value(_Name,Value,SVal,_) :- |
1007 | | b_value_to_string(Value,SVal). |
1008 | | |
1009 | | % do not convert to string; these are treated separately |
1010 | | raw_value_attribute(hovers). |
1011 | | raw_value_attribute(events). |
1012 | | |
1013 | | % now checked by check_attribute_type for updates, we could later check strings, currentcolor is allowed |
1014 | | illegal_color(pred_false). |
1015 | | illegal_color(pred_true). |
1016 | | illegal_color([]). |
1017 | | illegal_color(avl_set(_)). |
1018 | | illegal_color([_|_]). |
1019 | | illegal_color(closure(_,_,_)). |
1020 | | illegal_color(term(floating(_))). |
1021 | | |
1022 | | % evaluate a DEFINITION to a set of B records representing SVG objects |
1023 | | get_visb_DEFINITION_svg_object(SpecialClass,DefName,Body,DefPos,ExpandedState,SVG_ID,AttrList,Desc) :- |
1024 | | evaluate_visb_formula(Body,DefName,'',ExpandedState,ResValue,DefPos), |
1025 | | flex_expand(ResValue,DefName,DefPos,Expanded,[]), |
1026 | | (Expanded = [] -> add_message(visb_visualiser,'Empty set of SVG object records: ',DefName,DefPos) |
1027 | | ; Expanded =[Record|_] -> |
1028 | | (get_VISB_record_fields(Record,Fs) |
1029 | | % TODO: as we now can have different type of records, check in flex_expand below |
1030 | ? | -> (member(field(id,_),Fs) |
1031 | | -> true |
1032 | | ; add_message(visb_visualiser,'DEFINITION needs an `id` field if you want to use updates: ',DefName,DefPos) |
1033 | | ) |
1034 | | ; ajoin(['DEFINITION ', DefName,' should evaluate to a set of records or tuples of records: '],Msg), |
1035 | | add_warning(visb_visualiser,Msg,Record,DefPos) |
1036 | | ) |
1037 | | ), |
1038 | ? | member(Records,Expanded), |
1039 | | get_VISB_record_fields(Records,Fields), |
1040 | ? | (select(field(id,VID),Fields,F1) |
1041 | | -> extract_attribute_value(DefPos,id,VID,SVG_ID) |
1042 | | ; gensym(svg_id,SVG_ID), F1=Fields), |
1043 | | (select(field(comment,CC),F1,F2), b_value_to_string(CC,Desc) -> true |
1044 | | ; Desc = '', F2=F1), |
1045 | | (SpecialClass=visb_updates, member(field(visibility,VV),F2), |
1046 | | is_invisible(VV), |
1047 | | \+ visb_has_visibility_hover(SVG_ID) % check for hover which may make object visible |
1048 | | -> AttrList=[svg_attribute(visibility,'hidden')] % do not transmit updates |
1049 | ? | ; include_maplist(extract_attribute_from_record(DefPos),F2,AttrList), |
1050 | ? | (select(svg_attribute(svg_class,SVG_Class),AttrList,A2) |
1051 | | -> maplist(check_attribute_is_supported(SVG_Class,DefPos),A2) |
1052 | | ; true) |
1053 | | ). |
1054 | | |
1055 | | is_invisible(string(hidden)). % also treat collapse ? |
1056 | | is_invisible(pred_false). |
1057 | | |
1058 | | % expand nested tuples/sets to a single list of SVG records (possibly of different types) |
1059 | | flex_expand(Value,DefName,Pos) --> {is_custom_explicit_set(Value)},!, |
1060 | | {try_expand_custom_set_with_catch(Value,ExpandedSet,flex_expand), |
1061 | | (is_custom_explicit_set(ExpandedSet) |
1062 | | -> ajoin(['Could not expand set of SVG object records or tuples thereof for ',DefName,': '],Msg), |
1063 | | add_warning(visb_visualiser,Msg,Value,Pos), |
1064 | | fail |
1065 | | ; true)}, |
1066 | | flex_expand(ExpandedSet,DefName,Pos). |
1067 | | flex_expand([],_,_) --> !, []. |
1068 | | flex_expand(L,_DefName,_Pos) --> {L =[(string(_),string(_))|_]}, !, |
1069 | | [L]. % is probably a partial function {"id" |-> ,...} |
1070 | | flex_expand([H|T],DefName,Pos) --> !, flex_expand(H,DefName,Pos), l_flex_expand(T,DefName,Pos). |
1071 | | flex_expand((A,B),DefName,Pos) --> !, flex_expand(A,DefName,Pos), flex_expand(B,DefName,Pos). |
1072 | | flex_expand(T,_,_) --> [T]. |
1073 | | |
1074 | | l_flex_expand([],_,_) --> !, []. |
1075 | | l_flex_expand([H|T],DefName,Pos) --> !, flex_expand(H,DefName,Pos), l_flex_expand(T,DefName,Pos). |
1076 | | l_flex_expand(T,_,_) --> [T]. |
1077 | | |
1078 | | flex_member(X,SetPairVal,DefName,Pos) :- flex_expand(SetPairVal,DefName,Pos,List,[]), member(X,List). |
1079 | | |
1080 | | |
1081 | | % get the fields of a B value record |
1082 | | % also transparently handles alternative representations, like a function from STRING to STRING |
1083 | | get_VISB_record_fields(rec(Fields),Res) :- !, Res=Fields. |
1084 | | get_VISB_record_fields(StringFunction,Fields) :- |
1085 | | is_set_value(StringFunction,get_VISB_record_fields), |
1086 | | try_expand_custom_set_with_catch(StringFunction,Expanded,get_VISB_record_fields), |
1087 | | % TODO: check we have no duplicates |
1088 | | maplist(convert_to_field,Expanded,Fields). |
1089 | | % TODO: support records as generated by READ_XML: |
1090 | | % rec(attributes:{("fill"|->"#90ee90"),("height"|->"360px"),("id"|->"background_rect"),("width"|->"600px"),("x"|->"1px"),("y"|->"2px")},element:"rect",meta:{("xmlLineNumber"|->"3")},pId:5,recId:6) |
1091 | | % for <rect height="360px" x="1px" y="2px" id="background_rect" width="600px" fill="#90ee90"></rect> |
1092 | | |
1093 | | convert_to_field((string(FieldName),Value),field(FieldName,Value)). |
1094 | | % TODO: maybe handle enumerated set values as field names |
1095 | | |
1096 | | |
1097 | | % already extract and type-check VISB_SVG_UPDATES definitions |
1098 | | precompile_svg_object_updates :- |
1099 | | b_sorted_b_definition_prefixed(expression,'VISB_SVG_UPDATES',DefName,DefPos), |
1100 | | b_get_typed_definition(DefName,[variables_and_additional_defs],TypedExpr), |
1101 | | assert_visb_udpate_def_body(visb_updates,DefName,TypedExpr,DefPos), |
1102 | | fail. |
1103 | | precompile_svg_object_updates. |
1104 | | |
1105 | | % assert VisB updates or hovers from B DEFINITION, |
1106 | | % either from VISB_SVG_UPDATES or hovers or dynamic parts of VISB_SVG_OBJECTS: |
1107 | | assert_visb_udpate_def_body(_Kind,DefName,TypedExpr,_DefPos) :- |
1108 | | TypedExpr=b(rec([field(id,_)]),_,Info),!, % can happen when all fields are static |
1109 | | add_debug_message(visb_visualiser,'Useless update/hover (just id field): ',DefName,Info). |
1110 | | assert_visb_udpate_def_body(Kind,DefName,TypedExpr,DefPos) :- |
1111 | | get_texpr_type(TypedExpr,Type), |
1112 | | determine_type_of_visb_formula(TypedExpr,_,FormulaClass), |
1113 | | debug_format(19,'Detected ~w: ~w (~w)~n',[Kind,DefName,FormulaClass]), |
1114 | | assertz(visb_special_definition(Kind,DefName,Type,TypedExpr,FormulaClass,DefPos)), |
1115 | | check_visb_update_type(Kind,Type,DefName,unknown_svg_class,DefPos). |
1116 | | |
1117 | | % assert VisB events or hovers from B DEFINITION, from part of VISB_SVG_OBJECTS: |
1118 | | % supporting event attribute and optional predicate attribute |
1119 | | % Kind = visb_events or visb_hovers |
1120 | | add_visb_events_from_def_body(Kind,DefName,Body,DefPos) :- |
1121 | | get_texpr_type(Body,Type), |
1122 | | \+ empty_update_or_hover_type(Type), % at least one more field than just id field |
1123 | | get_visb_static_svg_object_for_typed_expr(Kind,DefName,Body,DefPos,SVG_ID,AttrList,Desc), |
1124 | | add_visb_object_from_definition(Kind, SVG_ID, AttrList, Desc, DefName, DefPos), |
1125 | | fail. |
1126 | | add_visb_events_from_def_body(_,_,_,_). |
1127 | | |
1128 | | empty_update_or_hover_type(record(Fields)) :- !, Fields \= [_,_|_]. % at least one more field than just id field |
1129 | | empty_update_or_hover_type(set(X)) :- !, empty_update_or_hover_type(X). |
1130 | | empty_update_or_hover_type(couple(A,B)) :- !, empty_update_or_hover_type(A), empty_update_or_hover_type(B). |
1131 | | |
1132 | | get_svg_object_updates_from_definitions(ExpandedBState,SVG_ID,SvgAttribute,Value,DefPos) :- |
1133 | ? | visb_special_definition(visb_updates,DefName,_Type,BodyTypedExpr,_Class,DefPos), |
1134 | ? | get_visb_DEFINITION_svg_object(visb_updates,DefName,BodyTypedExpr,DefPos,ExpandedBState,SVG_ID,AttrList,_Desc), |
1135 | ? | member(svg_attribute(SvgAttribute,Value),AttrList). |
1136 | | |
1137 | | check_visb_update_type(Kind,Type,DefName,Class,DefPos) :- |
1138 | | get_update_record_fields_type(Type,Fields), |
1139 | | % other types are STRING +-> STRING, ...; this will be checked in get_visb_DEFINITION_svg_object |
1140 | | (memberchk(field('svg_class',_),Fields) |
1141 | | -> add_warning(visb_visualiser,'VisB updates should not set svg_class:',DefName,DefPos) |
1142 | | ; true), |
1143 | ? | member(field(Name,FieldType),Fields), |
1144 | | (Name = trigger_id -> |
1145 | | (Kind=visb_hovers -> true ; |
1146 | | add_warning(visb_visualiser,'Attribute trigger_id can only be used for hovers:',DefName,DefPos) |
1147 | | ) |
1148 | | ; check_attribute_type(FieldType,Name,DefName,Class,DefPos) |
1149 | | ), |
1150 | | fail. |
1151 | | check_visb_update_type(_,_,_,_,_). |
1152 | | |
1153 | | % get a fields type list from a type |
1154 | | get_update_record_fields_type(set(X),Fields) :- !, |
1155 | | get_update_record_fields_type(X,Fields). |
1156 | | get_update_record_fields_type(record(Fields),R) :- !, R=Fields. |
1157 | | get_update_record_fields_type(couple(A,B),Fields) :- |
1158 | | (get_update_record_fields_type(A,Fields) |
1159 | | ; get_update_record_fields_type(B,Fields)). |
1160 | | |
1161 | | :- use_module(probsrc(translate), [pretty_type/2]). |
1162 | | % check B type of a field for an SVG update or object |
1163 | | check_attribute_type(Type,Name,DefName,Class,DefPos) :- alternative_spelling(Name,AName),!, |
1164 | | check_attribute_type(Type,AName,DefName,Class,DefPos). |
1165 | | check_attribute_type(Type,Name,DefName,Class,DefPos) :- Class \= unknown_svg_class, |
1166 | | check_is_number_attribute(Name,Class,DefPos),!, |
1167 | | illegal_number_type(Type), |
1168 | | ajoin(['Type of field ',Name,' of ', DefName, ' is not a number: '],Msg), |
1169 | | pretty_type(Type,TS), |
1170 | | add_warning(visb_visualiser,Msg,TS,DefPos). |
1171 | | check_attribute_type(Type,Name,DefName,_,DefPos) :- |
1172 | | is_svg_color_attribute(Name),!, |
1173 | | illegal_col_type(Type), |
1174 | | ajoin(['Type of field ',Name,' of ', DefName, ' is not a color: '],Msg), |
1175 | | pretty_type(Type,TS), |
1176 | | add_warning(visb_visualiser,Msg,TS,DefPos). |
1177 | | check_attribute_type(_Type,Name,_DefName,Class,DefPos) :- |
1178 | | check_attribute_name_is_supported(Class,Name,DefPos). |
1179 | | |
1180 | | illegal_nr_or_col_type(boolean). |
1181 | | illegal_nr_or_col_type(set(_)). |
1182 | | illegal_nr_or_col_type(seq(_)). |
1183 | | illegal_nr_or_col_type(record(_)). |
1184 | | illegal_nr_or_col_type(couple(A,B)) :- (illegal_nr_or_col_type(A) -> true ; illegal_nr_or_col_type(B)). |
1185 | | % check if couple types can work by concatenating string representations |
1186 | | |
1187 | | illegal_col_type(X) :- illegal_nr_or_col_type(X),!. |
1188 | | illegal_col_type(real). |
1189 | | % integer ? or can we map integers to colours using a color scheme like in DOT? |
1190 | | |
1191 | | illegal_number_type(X) :- illegal_nr_or_col_type(X),!. |
1192 | | %illegal_number_type(global(_)). % what if we use a global set with weird constants using back-quotes ? |
1193 | | |
1194 | | % ---------------- |
1195 | | |
1196 | | % parse and load an individual JSON VisB item, e.g, : |
1197 | | % { "name":"xscale", |
1198 | | % "value" : "(100.0 / real(TrackElementNumber))" |
1199 | | % } |
1200 | | |
1201 | | process_json_definition(File,json(List)) :- |
1202 | | (get_attr_true(ignore,List,File) -> true % ignore this definition |
1203 | | ; process_json_def_lst(File,List)). |
1204 | | |
1205 | | :- use_module(probsrc(bsyntaxtree), [get_texpr_type/2]). |
1206 | | process_json_def_lst(File,List) :- |
1207 | | force_del_attr_with_pos(name,List,string(ID),L1,File,NamePos), |
1208 | | force_del_attr_with_pos(value,L1,string(Formula),L2,File,VPos), |
1209 | | debug_format(19,' Processing definition for ~w with value-formula (lines ~w):~w~n',[ID,VPos,Formula]), |
1210 | | !, |
1211 | | set_gen_parse_errors(L2,VPos,GenParseErrors), % treat optional attribute |
1212 | | process_json_definition(ID,NamePos,Formula,VPos,GenParseErrors). |
1213 | | process_json_def_lst(File,List) :- get_pos_from_list(List,File,Pos), |
1214 | | add_error(visb_visualiser,'Illegal VisB Definition:',List,Pos). |
1215 | | |
1216 | | % we could also load a classical B Definition file and process its definitions like this: |
1217 | | process_json_definition(ID,NamePos,Formula,VPos,GenParseErrors) :- |
1218 | | atom_codes(Formula,FCodes), |
1219 | | set_error_context(visb_error_context(definition,ID,'value',VPos)), |
1220 | | (b_get_definition(ID,_DefType,_Args,_RawExpr,_Deps) |
1221 | | -> add_warning(visb_visualiser,'Ignoring VisB definition, DEFINITION of the same name already exists:',ID,NamePos) |
1222 | | ; parse_expr(FCodes,TypedExpr,GenParseErrors) |
1223 | | -> add_visb_json_definition(ID,TypedExpr,VPos) |
1224 | | ; GenParseErrors=false -> formatsilent('Ignoring optional VisB definition for ~w due to error in B formula~n',[ID]) |
1225 | | ; add_error(visb_visualiser,'Cannot parse or typecheck VisB formula for definition',ID,VPos) |
1226 | | ), |
1227 | | clear_error_context. |
1228 | | |
1229 | | add_visb_json_definition(ID,TypedExpr,VPos) :- |
1230 | | get_texpr_type(TypedExpr,Type), |
1231 | | determine_type_of_visb_formula(TypedExpr,TIds,Class), %write(type(ID,Class,TIds)),nl, |
1232 | | (try_eval_static_def(Class,'static definition', ID,TypedExpr,TIds,StaticValue,VPos) |
1233 | | -> get_texpr_type(TypedExpr,Type),StaticValueExpr = b(value(StaticValue),Type,[]), |
1234 | | assert_visb_json_definition(ID,Type,StaticValueExpr,TIds,Class,VPos) |
1235 | | ; assert_visb_json_definition(ID,Type,TypedExpr,TIds,Class,VPos) |
1236 | | ). |
1237 | | |
1238 | | % assert a VisB definition stemming from the JSON definitions section: |
1239 | | assert_visb_json_definition(DefName,Type,TypedExpr,UsedTIds,Class,DefPos) :- |
1240 | | (is_special_visb_def_name(DefName,SpecialClass) -> true ; SpecialClass = regular_def), |
1241 | | assertz(visb_definition(DefName,Type,TypedExpr,Class,DefPos,SpecialClass)), |
1242 | | (SpecialClass \= regular_def |
1243 | | -> formatsilent('Detected special ~w definition ~w (~w)~n',[SpecialClass,DefName,Class]), |
1244 | | add_special_json_definition(SpecialClass,DefName,Type,TypedExpr,UsedTIds,Class,DefPos) |
1245 | | ; true |
1246 | | ). |
1247 | | |
1248 | | % register some special definitions, in which a set of objects/hovers/updates can be specified |
1249 | | % by a single definition returning a set of records |
1250 | | add_special_json_definition(visb_updates,DefName,Type,TypedExpr,_,Class,DefPos) :- !, |
1251 | | check_visb_update_type(visb_updates,Type,DefName,Class,DefPos), |
1252 | | assertz(visb_special_definition(visb_updates,DefName,Type,TypedExpr,Class,DefPos)). % will be evaluated later |
1253 | | add_special_json_definition(visb_contents,DefName,Type,TypedExpr,_,Class,DefPos) :- !, |
1254 | | assertz(visb_special_definition(visb_contents,DefName,Type,TypedExpr,Class,DefPos)). |
1255 | | add_special_json_definition(visb_box,DefName,Type,TypedExpr,_,Class,DefPos) :- !, |
1256 | | assertz(visb_special_definition(visb_box,DefName,Type,TypedExpr,Class,DefPos)). |
1257 | | add_special_json_definition(visb_objects,DefName,_Type,TypedExpr,_UsedTIds,_Class,DefPos) :- !, |
1258 | | AllowSep=allow_separation, % TODO: we re-determine the class and used ids below: |
1259 | | get_typed_static_definition_with_constants_state(DefName,TypedExpr,ResBody,DefPos,CS,no_inlining,AllowSep), |
1260 | | (get_visb_DEFINITION_svg_object(visb_objects,DefName,ResBody,DefPos,CS,SVG_ID,AttrList,Desc), |
1261 | | %formatsilent('Adding ~w : ~w (from ~w)~n',[visb_objects,SVG_ID,DefName]), |
1262 | | add_visb_object_from_definition(visb_objects, SVG_ID, AttrList, Desc, DefName, DefPos), |
1263 | | fail ; true). |
1264 | | add_special_json_definition(SpecialClass,DefName,_Type,TypedExpr,UsedTIds,Class,DefPos) :- |
1265 | | (get_unique_initial_state_for_visb(Class,DefName,DefPos,UsedTIds,ConstantsState) -> true |
1266 | | ; ConstantsState=[]), |
1267 | | get_static_visb_state(ConstantsState,FullState), % add static VisB Defs |
1268 | | (Class=requires_variables, |
1269 | | (get_preference(visb_allow_variables_for_objects,false) ; ConstantsState=[]) |
1270 | | -> add_warning(visb_visualiser,'Ignoring VisB definition which requires variables:',DefName,DefPos) |
1271 | | ; get_visb_DEFINITION_svg_object(SpecialClass,DefName,TypedExpr,DefPos,FullState,SVG_ID,AttrList,Desc), |
1272 | | %formatsilent('Adding ~w : ~w (from ~w)~n',[SpecialClass,SVG_ID,DefName]), |
1273 | | add_visb_object_from_definition(SpecialClass, SVG_ID, AttrList, Desc, DefName, DefPos) |
1274 | | ; true). |
1275 | | |
1276 | | is_special_visb_def_name(DefName,visb_updates) :- atom_concat('VISB_SVG_UPDATES',_,DefName). |
1277 | | is_special_visb_def_name(DefName,visb_hovers) :- atom_concat('VISB_SVG_HOVERS',_,DefName). |
1278 | | is_special_visb_def_name(DefName,visb_objects) :- atom_concat('VISB_SVG_OBJECTS',_,DefName). |
1279 | | is_special_visb_def_name(DefName,visb_contents) :- atom_concat('VISB_SVG_CONTENTS',_,DefName). |
1280 | | is_special_visb_def_name('VISB_SVG_BOX',visb_box). |
1281 | | % TODO: maybe provide VISB_HTML_CONTENTS which appear after the SVG |
1282 | | |
1283 | | % evaluate static VisB defs only once or evaluate expressions in svg_objects and loop bounds |
1284 | | eval_static_def(Class,VisBKind,ID,TypedExpr,UsedTIds,StaticValue,VPos) :- |
1285 | | get_unique_initial_state_for_visb(Class,ID,VPos,UsedTIds,ConstantsState), |
1286 | | evaluate_static_visb_formula(TypedExpr,VisBKind,ID,ConstantsState,StaticValue,VPos). |
1287 | | |
1288 | | % only evaluate statically if possible; no warnings/messages if not possible (just fail) |
1289 | | try_eval_static_def(requires_variables,_VisBKind,_ID,_TypedExpr,_UsedTIds,_StaticValue,_VPos) :- !, |
1290 | | fail. % do not try to evaluate statically; events will change the variable values anyway |
1291 | | try_eval_static_def(Class,VisBKind,ID,TypedExpr,UsedTIds,StaticValue,VPos) :- |
1292 | | % TODO: disable messages for multiple constants values; just fail |
1293 | | eval_static_def(Class,VisBKind,ID,TypedExpr,UsedTIds,StaticValue,VPos). |
1294 | | |
1295 | | % check if a unique constant value exists for a model |
1296 | | get_unique_initial_state_for_visb(requires_nothing,_,_,_,State) :- !, State=[]. |
1297 | | get_unique_initial_state_for_visb(Class,DefName,DefPos,_,State) :- |
1298 | | \+ multiple_concrete_constants_exist, |
1299 | | is_concrete_constants_state_id(StateID),!, |
1300 | | (Class=requires_variables |
1301 | | -> get_preference(visb_allow_variables_for_objects,true), |
1302 | | unique_initialisation_id_exists_from(StateID,DefName,DefPos,State) |
1303 | | % Note: variable can still be modified by other events later, e.g., in ProB2-UI |
1304 | | ; visited_expression(StateID,StateTerm), |
1305 | | state_corresponds_to_set_up_constants_only(StateTerm,State)). |
1306 | | get_unique_initial_state_for_visb(requires_constants,DefName,DefPos,Ids,State) :- Ids \= all, |
1307 | | % try and see if all values for Ids are the same; TODO: also support requires_variables |
1308 | | is_concrete_constants_state_id(StateID),!, |
1309 | | visited_expression(StateID,StateTerm), |
1310 | | state_corresponds_to_set_up_constants_only(StateTerm,State), |
1311 | | (member(C,Ids), get_texpr_id(C,CstID), |
1312 | | other_constant_value_exists_for(CstID,State,StateID) |
1313 | | -> ajoin(['Multiple values for constant ',CstID, ' in context of: '],Msg), |
1314 | | add_message(visb_visualiser,Msg,DefName,DefPos),fail |
1315 | | ; true). |
1316 | | |
1317 | | get_a_constants_state(State,StateID,inline_objects(SingleStateId)) :- |
1318 | | get_constants_state_id_for_id(SingleStateId,StateID),!, |
1319 | | visited_expression(StateID,StateTerm), |
1320 | | state_corresponds_to_set_up_constants_only(StateTerm,State). |
1321 | | get_a_constants_state(State,StateID,InlineObjects) :- |
1322 | | check_inlining(InlineObjects), |
1323 | | is_concrete_constants_state_id(StateID),!, |
1324 | | visited_expression(StateID,StateTerm), |
1325 | | state_corresponds_to_set_up_constants_only(StateTerm,State). |
1326 | | |
1327 | | check_inlining(no_inlining) :- !. |
1328 | | check_inlining(inline_objects(_SingleStateId)) :- !. |
1329 | | check_inlining(X) :- add_internal_error('Invalid inlining value:',check_inlining(X)). |
1330 | | |
1331 | | :- use_module(probsrc(store), [lookup_value_for_existing_id/3]). |
1332 | | other_constant_value_exists_for(CstID,State,StateId) :- |
1333 | | lookup_value_for_existing_id(CstID,State,Val1), |
1334 | | is_concrete_constants_state_id(StateId2), StateId2 \= StateId, |
1335 | | visited_expression(StateId2,StateTerm2), |
1336 | | state_corresponds_to_set_up_constants_only(StateTerm2,State2), |
1337 | | lookup_value_for_existing_id(CstID,State2,Val2), |
1338 | | Val2 \= Val1. |
1339 | | |
1340 | | |
1341 | | unique_initialisation_id_exists_from(FromStateId,DefName,DefPos,State) :- |
1342 | | transition(FromStateId,_,StateID),!, |
1343 | | (transition(FromStateId,_,StateID2), |
1344 | | StateID2 \= StateID |
1345 | | -> ajoin(['Multiple initialisations exists (state ids ',StateID,',',StateID2,') for: '],Msg), |
1346 | | add_message(visb_visualiser,Msg,DefName,DefPos),fail |
1347 | | ; true), |
1348 | | visited_expression(StateID,StateTerm), |
1349 | | state_corresponds_to_initialised_b_machine(StateTerm,State). |
1350 | | |
1351 | | parse_expr_for_visb(Formula,JsonList,Pos,TypedExpr) :- |
1352 | | set_gen_parse_errors(JsonList,Pos,GenParseErrors), |
1353 | | parse_expr(Formula,TypedExpr,GenParseErrors). |
1354 | | |
1355 | | set_gen_parse_errors(JSonList,Pos,GenParseErrors) :- |
1356 | | (get_attr(optional,JSonList,_) |
1357 | | -> GenParseErrors=false |
1358 | | ; %get_pos_from_list(JSonList,File,Position), |
1359 | | GenParseErrors=gen_parse_errors_for(Pos)). |
1360 | | |
1361 | | % ---------------- |
1362 | | |
1363 | | % parse and load an individual JSON SVG object listed under svg_objects, e.g, : |
1364 | | % { |
1365 | | % "svg_class":"rect", |
1366 | | % "id":"train_rect", |
1367 | | % "x":"0", |
1368 | | % "y":"0", |
1369 | | % "comment":"..." |
1370 | | % }, |
1371 | | process_json_svg_object(File,Json) :- |
1372 | | process_repeat(0,Json,File,add_visb_json_svg_object). |
1373 | | |
1374 | | add_visb_json_svg_object(File,json(List)) :- get_attr_true(ignore,List,File), !. % ignore this item |
1375 | | add_visb_json_svg_object(File,json(List)) :- |
1376 | | (force_del_attr_with_pos(svg_class,List,string(SVG_Class),L1,File,Pos1) -> true % shape: line, rect, ... |
1377 | | ; infer_svg_class(List,SVG_Class,File,Pos1) |
1378 | | -> add_message(visb_visualiser,'Inferred svg_class: ',SVG_Class,Pos1),L1=List), |
1379 | | force_del_attr(id,L1,string(ID),L2,File), |
1380 | | (del_attr(comment,L2,string(Desc),JsonList3) -> true ; Desc = '', JsonList3=L2), |
1381 | | debug_format(19,' Creating new SVG object ~w with id:~w~n',[SVG_Class,ID]), |
1382 | | add_debug_message(visb_visualiser,'New object: ',ID,Pos1), |
1383 | | % TODO: we could pre-process all attributes not depending on %0, %1, ... |
1384 | | maplist(get_svg_attr(SVG_Class,File),JsonList3,AttrList), |
1385 | | %formatsilent('Adding SVG Object ~w with ID ~w (~w): ~w~n',[SVG_Class,ID,Desc,AttrList]), |
1386 | | assert_visb_svg_object(ID,SVG_Class,AttrList,Desc,Pos1), |
1387 | | !. |
1388 | | add_visb_json_svg_object(File,Json) :- |
1389 | | !, |
1390 | | get_pos_from_list(Json,File,Pos), |
1391 | | add_error(visb_visualiser,'Illegal VisB additional SVG object:',Json,Pos). |
1392 | | |
1393 | | infer_svg_class(List,line,File,Pos) :- get_attr_with_pos(x1,List,_,File,Pos),!. |
1394 | | infer_svg_class(List,circle,File,Pos) :- get_attr_with_pos(r,List,_,File,Pos),!. |
1395 | | infer_svg_class(List,rect,File,Pos) :- get_attr_with_pos(height,List,_,File,Pos),!. |
1396 | | infer_svg_class(List,rect,File,Pos) :- get_attr_with_pos(width,List,_,File,Pos),!. |
1397 | | infer_svg_class(List,ellipse,File,Pos) :- get_attr_with_pos(rx,List,_,File,Pos),!. % could also be rect |
1398 | | infer_svg_class(List,text,File,Pos) :- get_attr_with_pos(text,List,_,File,Pos),!. |
1399 | | infer_svg_class(List,g,File,Pos) :- get_attr_with_pos(children,List,_,File,Pos),!. % group + foreignObject have children |
1400 | | infer_svg_class(List,use,File,Pos) :- get_attr_with_pos(href,List,_,File,Pos),!. % href can also be used with image, pattern, ... |
1401 | | |
1402 | | % assert a new SVG object to be created upon SETUP_CONSTANTS/INITIALISATION: |
1403 | | assert_visb_svg_object(ID,SVG_Class,_AttrList,_Desc,Pos1) :- |
1404 | | visb_svg_object(ID,_,_,_,_Pos0),!, |
1405 | | ajoin(['SVG object (svg_class=',SVG_Class,') with same id already created: '],Msg), |
1406 | | add_warning(visb_visualiser,Msg,ID,Pos1). |
1407 | | assert_visb_svg_object(_ID,_SVG_Class,AttrList,_Desc,Pos1) :- |
1408 | | \+ (AttrList=[] ; AttrList=[_|_]),!, |
1409 | | add_error(visb_visualiser,'SVG objects attributes are not a list:',AttrList,Pos1). |
1410 | | assert_visb_svg_object(ID,SVG_Class,AttrList,Desc,Pos1) :- |
1411 | | check_svg_shape_class(ID,SVG_Class,Pos1), |
1412 | | sort(AttrList,SAttrList), |
1413 | | get_all_children(SAttrList,Children,RestAttrs,Pos1), |
1414 | | (Children = [] -> true |
1415 | ? | ; svg_shape_can_have_children(SVG_Class) -> true |
1416 | | ; Children = [C1_ID|_], visb_svg_object(C1_ID,CAttr,_,_,_), |
1417 | | attribute_automatically_creates_children(CAttr) -> true |
1418 | | ; add_message(visb_visualiser,'Children attribute only useful for certain classes such as groups (g) or when adding title objects (as tooltips): ',Children,Pos1) |
1419 | | ), |
1420 | ? | (select(svg_attribute(group_id,ParentGroupId),RestAttrs,RestAttrs2) |
1421 | | -> assert_visb_svg_child(ParentGroupId,Pos1,ID) % register parent group id |
1422 | | ; RestAttrs2=RestAttrs), |
1423 | | compute_auto_attributes(RestAttrs,RestAttrs2,SVG_Class,NewRestAttrs), |
1424 | | assertz(visb_svg_object(ID,SVG_Class,NewRestAttrs,Desc,Pos1)), |
1425 | | maplist(assert_visb_svg_child(ID,Pos1),Children). |
1426 | | |
1427 | | % compute the value of VisB auto attributes, e.g., automatically |
1428 | | % doing a layout of objects in a grid |
1429 | | % TODO: SVG/special_svg_number already supports auto but not for x,y coordinates? |
1430 | | % TODO: try and determine width of object automatically; keep track of auto objects max height per row |
1431 | | % TODO: support cx,cy |
1432 | | compute_auto_attributes([],_,_,[]). |
1433 | | compute_auto_attributes([svg_attribute(Attr,Val)|T],AllAttrs,SVG_Class, |
1434 | | [svg_attribute(Attr,NewVal)|NT]) :- |
1435 | | (Val=auto, compute_auto_attribute(Attr,AllAttrs,SVG_Class,NewVal) |
1436 | | -> true |
1437 | | ; NewVal=Val), |
1438 | | compute_auto_attributes(T,AllAttrs,SVG_Class,NT). |
1439 | | |
1440 | | :- dynamic next_auto_x/1, next_auto_y/2. |
1441 | | next_auto_x(0). |
1442 | | next_auto_y(0,10). |
1443 | | reset_auto_attrs :- retractall(next_auto_x(_)), |
1444 | | retractall(next_auto_y(_,_)), |
1445 | | assertz(next_auto_x(0)), |
1446 | | assertz(next_auto_y(0,10)). |
1447 | | |
1448 | | get_x_auto_limit(Limit) :- visb_empty_svg_box_height_width(_H,W,_ViewBox),!, |
1449 | | Limit = W. %TODO: inspect viewBox |
1450 | | get_x_auto_limit(400). |
1451 | | |
1452 | | compute_auto_attribute(id,_,_,GenID) :- !, gensym(svg_id,GenID). |
1453 | | compute_auto_attribute(Attr,AllAttrs,SVG_Class,Val) :- |
1454 | | auto_compute_x_coordinate(Attr,Kind),!, |
1455 | | retract(next_auto_x(XV)), |
1456 | | (get_width(SVG_Class,AllAttrs,Offset) -> true ; Offset=10), |
1457 | | Padding = 2, % TODO: make customisable |
1458 | | NewXV is XV+Offset+Padding, |
1459 | | get_x_auto_limit(Lim), |
1460 | | (NewXV > Lim |
1461 | | -> NewVal=0, retract(next_auto_y(OldY,YOffset)), |
1462 | | (get_height(SVG_Class,AllAttrs,Offset) -> true ; Offset = 10), |
1463 | | NewY is OldY+YOffset, |
1464 | | assert(next_auto_y(NewY,YOffset)) |
1465 | | ; NewVal=NewXV), |
1466 | | assertz(next_auto_x(NewVal)), |
1467 | | (Kind=left -> Val=XV ; Val is XV + Offset/2). |
1468 | | compute_auto_attribute(Attr,AllAttrs,SVG_Class,Val) :- auto_compute_y_coordinate(Attr,Kind), |
1469 | | next_auto_y(YV,_), |
1470 | | (Kind = top -> Val = YV |
1471 | | ; get_height(SVG_Class,AllAttrs,Height) -> Val is YV + Height/2 |
1472 | | ; Val is YV+5). |
1473 | | |
1474 | | auto_compute_x_coordinate(x,left). % rect, .. |
1475 | | auto_compute_x_coordinate(cx,center). % circle, ellipse |
1476 | | auto_compute_y_coordinate(y,top). % rect, .. |
1477 | | auto_compute_y_coordinate(cy,center). % circle, ellipse |
1478 | | |
1479 | | get_width(rect,Attrs,Wid) :- member(svg_attribute(width,Wid),Attrs). |
1480 | | get_width(circle,Attrs,Wid) :- member(svg_attribute(r,Radius),Attrs), Wid is 2*Radius. |
1481 | | get_width(ellipse,Attrs,Wid) :- member(svg_attribute(rx,Radius),Attrs), Wid is 2*Radius. |
1482 | | get_width(line,Attrs,Wid) :- member(svg_attribute(x1,X1),Attrs), |
1483 | | member(svg_attribute(x2,X2),Attrs), Wid is abs(X2-X1). |
1484 | | |
1485 | | get_height(rect,Attrs,Wid) :- member(svg_attribute(height,Wid),Attrs). |
1486 | | get_height(circle,Attrs,Wid) :- member(svg_attribute(r,Radius),Attrs), Wid is 2*Radius. |
1487 | | get_height(ellipse,Attrs,Wid) :- member(svg_attribute(ry,Radius),Attrs), Wid is 2*Radius. |
1488 | | get_height(line,Attrs,Wid) :- member(svg_attribute(y1,X1),Attrs), |
1489 | | member(svg_attribute(y2,X2),Attrs), Wid is abs(X2-X1). |
1490 | | |
1491 | | |
1492 | | % register an SVG ID as child of a group |
1493 | | assert_visb_svg_child(_ParentId,Pos,ChildID) :- visb_svg_child(ChildID,OldParent),!, |
1494 | | ajoin(['SVG object already child of group ',OldParent,': '],Msg), |
1495 | | add_warning(visb_visualiser,Msg,ChildID,Pos). |
1496 | | assert_visb_svg_child(ParentId,Pos,ChildID) :- visb_svg_child(ParentId,ChildID),!, % TODO: full cycle detection |
1497 | | ajoin(['SVG object already parent of group ',ParentId,' (cycle): '],Msg), |
1498 | | add_warning(visb_visualiser,Msg,ChildID,Pos). |
1499 | | assert_visb_svg_child(ParentId,_Pos,ChildID) :- |
1500 | | assertz(visb_svg_child(ChildID,ParentId)), |
1501 | | assertz(visb_svg_parent(ParentId,ChildID)). |
1502 | | |
1503 | | |
1504 | | |
1505 | | |
1506 | | :- use_module(probsrc(gensym),[gensym/2]). |
1507 | | % we need to translate a title attribute to a separate title object and add it as a child |
1508 | | % see also post_process_visb_item which dispatches title updates to the child object |
1509 | | get_all_children(SAttrList,Children,Rest,Pos) :- |
1510 | ? | select(svg_attribute(title,Title),SAttrList,SList2),!, |
1511 | | gensym(visb_title,TitleID), |
1512 | | assert_visb_svg_object(TitleID,'title',[svg_attribute(text,Title)],'',Pos), |
1513 | | add_debug_message(visb_visualiser,'Adding virtual title child object: ',TitleID,Pos), |
1514 | | Children=[TitleID|TChilds], |
1515 | | get_children_attribute(SList2,TChilds,Rest,Pos). |
1516 | | get_all_children(SAttrList,Children,Rest,Pos) :- |
1517 | | % get the children explicitly defined by the user: |
1518 | | get_children_attribute(SAttrList,Children,Rest,Pos). |
1519 | | |
1520 | | get_children_attribute(SAttrList,Children,Rest,Pos) :- |
1521 | ? | select(svg_attribute(children,C),SAttrList,R),!, |
1522 | | (is_list(C) -> Children=C |
1523 | | ; add_warning(visb_visualiser,'Children attribute should be a list (of SVG ids): ',C,Pos), |
1524 | | Children=[]), |
1525 | | Rest=R. |
1526 | | get_children_attribute(SAttrList,[],SAttrList,_). |
1527 | | |
1528 | | |
1529 | | |
1530 | | :- use_module(probsrc(tools_matching), [get_possible_fuzzy_matches_and_completions_msg/3, |
1531 | | get_all_svg_classes/1, is_svg_shape_class/1, |
1532 | | is_html_tag/1, is_html_attribute/1]). |
1533 | | |
1534 | | |
1535 | | svg_shape_can_have_children(g). |
1536 | | svg_shape_can_have_children(foreignObject). |
1537 | | svg_shape_can_have_children(X) :- is_html_tag(X). |
1538 | | |
1539 | | |
1540 | | % check whether svg_class value seems valid |
1541 | | check_svg_shape_class(ID,Shape,Pos) :- |
1542 | | (is_svg_shape_class(Shape) -> true |
1543 | | ; is_html_tag(Shape) -> |
1544 | | (visb_svg_child(ID,ParentId), |
1545 | | visb_svg_object(ParentId,ParClass,_,_,_), |
1546 | | (is_html_tag(ParClass) -> true ; ParClass=foreignObject) |
1547 | | -> add_debug_message(visb_visualiser,'HTML tag used as svg_class in foreignObject child: ',Shape,Pos) |
1548 | | ; ajoin(['SVG object ', ID, ' has HTML tag as svg_class (and should probably be a child of a foreignObject): '],Msg), |
1549 | | add_message(visb_visualiser,Msg,Shape,Pos) % probably should be child of foreignObject |
1550 | | ) |
1551 | | ; get_all_svg_classes(Classes), |
1552 | | get_possible_fuzzy_matches_and_completions_msg(Shape,Classes,FMsg) |
1553 | | -> ajoin(['SVG object ', ID, ' has unknown svg_class (did you mean ',FMsg,' ?): '],Msg), |
1554 | | add_warning(visb_visualiser,Msg,Shape,Pos) |
1555 | | ; ajoin(['SVG object ', ID, ' has unknown svg_class: '],Msg), |
1556 | | add_message(visb_visualiser,Msg,Shape,Pos) |
1557 | | ). |
1558 | | |
1559 | | % get SVG attribute for an svg_object: |
1560 | | get_svg_attr(SVG_Class,File,'='(Attr,AttrVal,Pos),svg_attribute(Attr,Val)) :- !, |
1561 | | construct_prob_pos_term(Pos,File,PosTerm), |
1562 | | get_svg_static_attribute_value(Attr,SVG_Class,PosTerm,AttrVal,Val). |
1563 | | get_svg_attr(_,File,Json,_) :- |
1564 | | get_pos_from_list([Json],File,Position), |
1565 | | add_error(visb_visualiser,'Illegal SVG object attribute',Json,Position),fail. |
1566 | | |
1567 | | get_svg_static_attribute_value(Attr,SVG_Class,Pos,AttrVal,Nr) :- |
1568 | | check_is_number_attribute(Attr,SVG_Class,Pos), |
1569 | | \+ is_special_svg_number_form(AttrVal), |
1570 | | !, |
1571 | | (get_number_value(AttrVal,Nr,Attr,Pos) -> true |
1572 | | ; add_error(visb_visualiser,'Illegal number value:',AttrVal,Pos), Nr=0). |
1573 | | get_svg_static_attribute_value(_,_,_,string(Val),Res) :- !, Res=Val. |
1574 | | % for children we get something like array([string(button1_1),string(button1_2)]) |
1575 | | get_svg_static_attribute_value(Attr,SVG_Class,Pos,array(List),ResList) :- !, |
1576 | | maplist(get_svg_static_attribute_value(Attr,SVG_Class,Pos),List,ResList). |
1577 | | get_svg_static_attribute_value(_Attr,_,Pos,Val,Val) :- |
1578 | | add_warning(visb_visualiser,'Illegal SVG object attribute value: ',Val,Pos). |
1579 | | |
1580 | | |
1581 | | % detect special SVG number forms, like 50% |
1582 | | is_special_svg_number_form(string(Atom)) :- |
1583 | | atom_codes(Atom,Codes), |
1584 | | special_svg_number(Codes,[]). |
1585 | | |
1586 | | :- use_module(probsrc(self_check)). |
1587 | | :- assert_must_succeed(visb_visualiser:special_svg_number("10%",[])). |
1588 | | :- assert_must_succeed(visb_visualiser:special_svg_number("10 %",[])). |
1589 | | :- assert_must_succeed(visb_visualiser:special_svg_number(" 99em ",[])). |
1590 | | :- assert_must_succeed(visb_visualiser:special_svg_number("1.0em",[])). |
1591 | | :- assert_must_fail(visb_visualiser:special_svg_number("10",[])). |
1592 | | :- assert_must_fail(visb_visualiser:special_svg_number("10+nrcols+%0",[])). |
1593 | | special_svg_number --> " ",!, special_svg_number. |
1594 | | special_svg_number --> [X], {digit(X)},!, special_svg_number2. |
1595 | | special_svg_number --> "auto". |
1596 | | special_svg_number2 --> [X], {digit(X)},!, special_svg_number2. |
1597 | | special_svg_number2 --> ".",!, special_svg_number2. % TODO: only allow one dot; + accept e notation? |
1598 | ? | special_svg_number2 --> optws,!, svg_unit,!, optws. |
1599 | | |
1600 | | % using info from https://oreillymedia.github.io/Using_SVG/guide/units.html |
1601 | | svg_unit --> "%". |
1602 | | svg_unit --> "ch". |
1603 | | svg_unit --> "cm". |
1604 | | svg_unit --> "em". |
1605 | | svg_unit --> "ex". |
1606 | | svg_unit --> "in". |
1607 | | svg_unit --> "mm". |
1608 | | svg_unit --> "pc". |
1609 | | svg_unit --> "pt". |
1610 | | svg_unit --> "px". |
1611 | | svg_unit --> "deg". % angle units |
1612 | | svg_unit --> "grad". |
1613 | | svg_unit --> "rad". |
1614 | | svg_unit --> "turn". |
1615 | | svg_unit --> "rem". % root em |
1616 | | svg_unit --> "vh". % viewport height unit (1%) |
1617 | | svg_unit --> "vw". % viewport width unit (1%) |
1618 | | svg_unit --> "vmin". % min ov vh, vw |
1619 | | svg_unit --> "vmax". % max ov vh, vw |
1620 | | |
1621 | | |
1622 | | optws --> " ",!,optws. |
1623 | | optws --> []. |
1624 | | |
1625 | | digit(X) :- X >= 48, X =< 57. |
1626 | | |
1627 | | is_svg_number_attribute(Attr) :- is_svg_number_attribute(Attr,_). |
1628 | | |
1629 | | |
1630 | | :- use_module(probsrc(tools_matching), [dot2svg_synonym/2, is_dot_attribute/1]). |
1631 | | % some checks to see whether the attribute is supported by the given SVG class |
1632 | | |
1633 | | check_attribute_is_supported(SVG_Class,DefPos,svg_attribute(Name,_)) :- nonvar(SVG_Class), |
1634 | | check_is_number_attribute(Name,SVG_Class,DefPos),!. |
1635 | | % TODO: check color and other attributes, see also check_attribute_type |
1636 | | check_attribute_is_supported(SVG_Class,DefPos,svg_attribute(Name,_V)) :- !, |
1637 | | check_attribute_name_is_supported(SVG_Class,Name,DefPos). |
1638 | | check_attribute_is_supported(S,DefPos,F) :- |
1639 | | add_internal_error('Illegal call:',check_attribute_is_supported(S,DefPos,F)). |
1640 | | |
1641 | | |
1642 | | check_attribute_name_is_supported(SVG_Class,Name,DefPos) :- |
1643 | | nonvar(SVG_Class), |
1644 | | is_html_tag(SVG_Class), |
1645 | | \+ is_svg_shape_class(SVG_Class), % script and title can be both SVG and HTML |
1646 | | !, |
1647 | | (is_html_attribute(Name) |
1648 | | -> true % TODO: we could check whether attribute appropriate for Tag |
1649 | | ; is_virtual_svg_attribute(Name) -> true % Virtual VisB attribute like children, text, ... |
1650 | | ; ajoin(['Unknown HTML attribute used inside HTML tag ',SVG_Class,': '],Msg), |
1651 | | add_message(visb_visualiser,Msg,Name,DefPos) |
1652 | | ). |
1653 | | check_attribute_name_is_supported(_SVG_Class,Name,DefPos) :- |
1654 | ? | \+ is_svg_attribute(Name), |
1655 | | !, |
1656 | | (dot2svg_synonym(Name,GraphVizTranslName) |
1657 | | -> ajoin(['Unknown SVG attribute (maybe you want to use ',GraphVizTranslName,' ?): '],Msg), |
1658 | | add_warning(visb_visualiser,Msg,Name,DefPos) |
1659 | | ; get_all_svg_attributes(Attrs), |
1660 | | (get_possible_fuzzy_matches_and_completions_msg(Name,Attrs,FMsg) |
1661 | | -> ajoin(['Unknown SVG attribute (did you mean ',FMsg,' ?): '],Msg), |
1662 | | add_warning(visb_visualiser,Msg,Name,DefPos) % create warning, as it is likely we have made an error |
1663 | | ; is_dot_attribute(Name) |
1664 | | -> add_warning(visb_visualiser,'This Dot/Graphviz attribute is not a valid SVG attribute: ',Name,DefPos) |
1665 | | ; add_message(visb_visualiser,'Unknown SVG attribute: ',Name,DefPos) |
1666 | | ) |
1667 | | ). |
1668 | | check_attribute_name_is_supported(_,_,_). |
1669 | | |
1670 | | % succeed if attribute is a number attribute and perform a check the attribute is supported by the class |
1671 | | check_is_number_attribute(Attr,Class,Pos) :- |
1672 | | is_svg_number_attribute(Attr,ClassList), |
1673 | | (nonvar(Class), nonmember(Class,ClassList) |
1674 | | -> (equivalent_attribute(Attr,List2,NewAttr), member(Class,List2) |
1675 | | -> ajoin(['The number attribute ',Attr,' is not supported for SVG class ',Class,', use: '],Msg), |
1676 | | add_warning(visb_visualiser,Msg,NewAttr,Pos) |
1677 | | ; ajoin(['The number attribute ',Attr,' is not supported for this SVG class: '],Msg), |
1678 | | add_warning(visb_visualiser,Msg,Class,Pos) |
1679 | | ) |
1680 | | ; true |
1681 | | ). |
1682 | | |
1683 | | % optionally rewrite record field to alternative spelling |
1684 | | opt_rewrite_field_name(Name,Res) :- |
1685 | | (alternative_spelling(Name,Alt) -> Res=Alt ; Res=Name). |
1686 | | |
1687 | | % these alternatives are useful e.g. in TLA+ without backquote: |
1688 | | alternative_spelling(colour,'color'). |
1689 | | alternative_spelling(fill_opacity,'fill-opacity'). |
1690 | | alternative_spelling(fill_rule,'fill-rule'). |
1691 | | alternative_spelling(font_family,'font-family'). |
1692 | | alternative_spelling(font_size,'font-size'). |
1693 | | alternative_spelling(font_style,'font-style'). |
1694 | | alternative_spelling(font_variant,'font-variant'). |
1695 | | alternative_spelling(font_weight,'font-weight'). |
1696 | | alternative_spelling(marker_end,'marker-end'). |
1697 | | alternative_spelling(marker_start,'marker-start'). |
1698 | | alternative_spelling(stroke_opacity,'stroke-opacity'). |
1699 | | alternative_spelling(stroke_dasharray,'stroke-dasharray'). |
1700 | | %alternative_spelling('stroke-dash-array','stroke-dasharray'). |
1701 | | alternative_spelling(stroke_linecap,'stroke-linecap'). |
1702 | | alternative_spelling(stroke_linejoin,'stroke-linejoin'). |
1703 | | alternative_spelling(stroke_width,'stroke-width'). |
1704 | | |
1705 | | |
1706 | | |
1707 | | % used to suggest fixing unsupported attributes in SVG objects: |
1708 | | equivalent_attribute(cx,[rect],x). |
1709 | | equivalent_attribute(cy,[rect],y). |
1710 | | equivalent_attribute(x,[circle,ellipse],cx). |
1711 | | equivalent_attribute(x,[line],x1). |
1712 | | equivalent_attribute(y,[circle,ellipse],cy). |
1713 | | equivalent_attribute(y,[line],y1). |
1714 | | equivalent_attribute(r,[rect],rx). % ry also exists |
1715 | | equivalent_attribute(rx,[circle],r). |
1716 | | equivalent_attribute(width,[circle],r). |
1717 | | equivalent_attribute(width,[ellipse],rx). |
1718 | | equivalent_attribute(height,[ellipse],ry). |
1719 | | |
1720 | | |
1721 | | |
1722 | | |
1723 | | % ---------------- |
1724 | | |
1725 | | % parse and load an individual JSON VisB item, e.g, : |
1726 | | % { |
1727 | | % "id":"train_info_text", |
1728 | | % "attr":"x", |
1729 | | % "value":"real(train_rear_end)*100.0/real(TrackElementNumber+1)", |
1730 | | % "comment":"move info field above train" |
1731 | | % }, |
1732 | | process_visb_json_item(File,Json) :- |
1733 | | process_repeat(0,Json,File,add_visb_json_item). |
1734 | | |
1735 | | add_visb_json_item(File,json(List)) :- |
1736 | | get_attr_true(ignore,List,File), % ignore this item |
1737 | | !. |
1738 | | add_visb_json_item(File,json(List)) :- |
1739 | | del_attr_with_pos(id,List,string(ID),L1,File,PosStartOfItem), |
1740 | | !, |
1741 | | process_visb_json_item_id(File,L1,ID,PosStartOfItem). |
1742 | | add_visb_json_item(File,Json) :- |
1743 | | !, |
1744 | | get_pos_from_list(Json,File,Pos), |
1745 | | add_error(visb_visualiser,'VisB Item has no id attribute:',Json,Pos). |
1746 | | |
1747 | | process_visb_json_item_id(File,L1,ID,PosStartOfItem) :- |
1748 | ? | del_attr(attr,L1,string(Attr),L2), % VisB has attr and value infos |
1749 | | force_del_attr_with_pos(value,L2,string(Formula),L3,File,PosFormula), |
1750 | | !, |
1751 | ? | (del_attr(comment,L3,string(Desc),L4) -> true ; Desc = '',L4=L3), |
1752 | | debug_format(19,' Processing id:~w attr:~w : value:~w desc:~w~n',[ID,Attr,Formula,Desc]), |
1753 | | actually_add_visb_json_item(ID,Attr,Formula,Desc,L4,PosStartOfItem,PosFormula,File). |
1754 | | process_visb_json_item_id(File,L1,ID,PosStartOfItem) :- |
1755 | | get_attr(SomeSVGAttr,L1,_V), |
1756 | ? | is_svg_attribute(SomeSVGAttr), |
1757 | | debug_format(19,'Detected new style VisB JSON declaration with id:~w and SVG attr:~w~n',[ID,SomeSVGAttr]), |
1758 | | !, |
1759 | | % object is in new format with multiple attributes "x":"0" rather than "attr":"x", "value":"0" |
1760 | | (del_attr(comment,L1,string(Desc),L2) -> true ; Desc = '',L2=L1), |
1761 | ? | (non_det_del_attr_with_pos(SVGATTR,L2,string(Formula),L3,File,PosFormula), |
1762 | | is_visb_item_svg_attribute(PosFormula,SVGATTR,Formula), |
1763 | | debug_format(19,' -> Processing new style id:~w attr:~w : value:~w desc:~n',[ID,SVGATTR,Formula,Desc]), |
1764 | | actually_add_visb_json_item(ID,SVGATTR,Formula,Desc,L3,PosStartOfItem,PosFormula,File), |
1765 | | fail |
1766 | | ; |
1767 | | true). |
1768 | | process_visb_json_item_id(_File,_JsonList,ID,PosStartOfItem) :- |
1769 | | !, |
1770 | | add_error(visb_visualiser,'Illegal VisB Item without attr and value fields:',ID,PosStartOfItem). |
1771 | | |
1772 | | is_visb_item_svg_attribute(Pos,Attr,Val) :- |
1773 | | Attr \= override, % so we ignore a possible override attribute |
1774 | ? | (is_svg_attribute(Attr) -> true |
1775 | | ; add_warning(visb_visualiser,'Ignoring unknown attribute: ',Attr=Val,Pos), |
1776 | | fail |
1777 | | ). |
1778 | | |
1779 | | :- use_module(probsrc(tools_strings),[safe_name/2]). |
1780 | | actually_add_visb_json_item(ID,Attr,Formula,Desc,JsonList,PosStartOfItem,PosFormula,File) :- |
1781 | | set_error_context(visb_error_context(item,ID,Attr,PosFormula)), |
1782 | | atom_codes(Formula,FormulaC), |
1783 | | (parse_expr_for_visb(FormulaC,JsonList,PosFormula,TypedExpr) |
1784 | | % TO DO: if optional attribute present: avoid generating errors in b_parse_machine_expression_from_codes |
1785 | | -> assert_visb_item(ID,Attr,TypedExpr,Desc,PosStartOfItem,JsonList,File) |
1786 | | ; get_attr_with_pos(optional,JsonList,_,File,Pos) |
1787 | | -> formatsilent('Ignoring optional VisB item for ~w (lines ~w) due to error in B formula~n',[ID,Pos]) |
1788 | | ; ajoin(['Cannot parse or typecheck VisB formula for ',ID,' and attribute ',Attr,':'],Msg), |
1789 | | add_error(visb_visualiser,Msg,Formula,PosFormula) |
1790 | | ), clear_error_context. |
1791 | | |
1792 | | |
1793 | | :- use_module(probsrc(bsyntaxtree), [find_identifier_uses/3]). |
1794 | | % assert a VISB item (aka VISB_SVG_UPDATE) |
1795 | | assert_visb_item(ID,Attr,_TypedExpr,_Desc,PosStartOfItem,_,_) :- |
1796 | | visb_item(ID,Attr,_,_,_,Pos2,Meta2), |
1797 | | !, |
1798 | | get_file_name_msg(PosStartOfItem,From1,File1), |
1799 | | (member(override,Meta2) |
1800 | | -> ajoin(['Overriding VisB item',From1,File1,' for same SVG ID ',ID,' and attribute '],Msg), |
1801 | | add_debug_message(visb_visualiser,Msg,Attr,Pos2) |
1802 | | ; ajoin(['Overriding VisB item',From1,File1,' for same SVG ID ',ID, |
1803 | | '. Add an \"override\" attribute to remove this warning. Overriden attribute '],Msg), |
1804 | | add_warning(visb_visualiser,Msg,Attr,Pos2), |
1805 | | % error_context already includes attribute and ID |
1806 | | add_message(visb_visualiser,'Overriding this stored formula for ',ID,PosStartOfItem) % provide detailed info |
1807 | | ). |
1808 | | assert_visb_item(ID,Attr,_TypedExpr,_Desc,PosStartOfItem,_JsonList,_File) :- |
1809 | | illegal_attribute_for_visb_item(ID,Attr),!, |
1810 | | add_warning(visb_visualiser,'This attribute cannot be modified in a VisB item: ',Attr,PosStartOfItem). |
1811 | | assert_visb_item(ID,Attr,TypedExpr,Desc,PosStartOfItem,JsonList,File) :- |
1812 | | (get_attr_true(override,JsonList,File) -> Meta = [override] ; Meta=[]), |
1813 | | % determine_type_of_visb_formula(TypedExpr,_,Class) now does take definitions into account; TODO: save info |
1814 | | find_identifier_uses(TypedExpr,[],UsedIds), |
1815 | | assertz(visb_item(ID,Attr,TypedExpr,UsedIds,Desc,PosStartOfItem,Meta)). |
1816 | | |
1817 | | illegal_attribute_for_visb_item(_,children). |
1818 | | illegal_attribute_for_visb_item(_,group_id). |
1819 | | illegal_attribute_for_visb_item(_,id). |
1820 | | illegal_attribute_for_visb_item(_,svg_class). |
1821 | | |
1822 | | |
1823 | | get_file_name_msg(Pos1,' from ',File1) :- extract_tail_file_name(Pos1,File1),!. |
1824 | | get_file_name_msg(_,'',''). % no file info |
1825 | | |
1826 | | % ---- |
1827 | | |
1828 | | get_attr_true(Attr,JsonList,File) :- |
1829 | | get_attr_with_pos(Attr,JsonList,TRUE,File,Pos), |
1830 | | (json_true_value(TRUE) -> true |
1831 | | ; json_false_value(TRUE) -> fail |
1832 | | ; ajoin(['Value for attribute ',Attr,' is not true or false: '],Msg), |
1833 | | add_warning(visb_visualiser,Msg,TRUE,Pos) |
1834 | | ). |
1835 | | |
1836 | | json_true_value(@(true)). |
1837 | | json_true_value(string(true)). |
1838 | | json_true_value(number(1)). |
1839 | | |
1840 | | json_false_value(@(false)). |
1841 | | json_false_value(string(false)). |
1842 | | json_false_value(number(0)). |
1843 | | |
1844 | | % ---------------- |
1845 | | % FOR-LOOP / REPEAT processing |
1846 | | |
1847 | | %process_repeat(RepCounter, Json, FinalCall to be executed repeatedly for each instance with File and Json, File) |
1848 | | % RepCounter tells us which of %0, %1, ... should be replaced next |
1849 | | |
1850 | | process_repeat(RepCount,json(JsonList),File,FinalCall) :- |
1851 | ? | non_det_del_attr_with_pos(FOR_REP,JsonList,Value,RestJsonList,File,ForRepPos), |
1852 | | % find first for or repeat and process it |
1853 | | (FOR_REP=for ; FOR_REP=repeat), |
1854 | | !, |
1855 | | process_first_repeat(FOR_REP,Value,ForRepPos,RepCount,json(RestJsonList),File,FinalCall). |
1856 | | process_repeat(_RepCount,Json,File,FinalCall) :- |
1857 | | % we have processed all for/repeat loops: now perform the final call on the transformed codes |
1858 | | call(FinalCall,File,Json). |
1859 | | |
1860 | | process_first_repeat(for,json(ForList),ForPos,RepCount,JsonData,File,FinalCall) :- |
1861 | | !, % we have a for loop like "for": {"from":1, "to":4} |
1862 | | force_get_attr_nr(from,ForList,From,File), |
1863 | | force_get_attr_nr(to,ForList,To,File), |
1864 | | (get_attr_with_pos(step,ForList,StepAttrVal,File,StepPos), |
1865 | | get_number_value(StepAttrVal,Step,step,StepPos) |
1866 | | -> true % there is an explicit step attribute |
1867 | | ; Step=1), |
1868 | | debug_format(19,' -> Iterating %~w from ~w to ~w with step ~w~n',[RepCount,From,To,Step]), |
1869 | | R1 is RepCount+1, |
1870 | | number_codes(RepCount,Pat), |
1871 | | check_between(From,To,Step,ForPos), % check whether step value makes sense |
1872 | ? | ( between(From,To,Step,IterElem), |
1873 | | number_codes(IterElem,IterElemC), % we will replace the text %Pat by the text of the number IterElem |
1874 | | replace_in_json(Pat,IterElemC,JsonData,ReplacedJsonData), % replace within other for/repeat loops, but also other attributes |
1875 | | process_repeat(R1,ReplacedJsonData,File,FinalCall), % now process next loop or finish |
1876 | | fail |
1877 | | ; true). |
1878 | | process_first_repeat(repeat,array(RepList),RepPos,RepCount,JsonData,File,FinalCall) :- |
1879 | | !, % we have a repetition like "repeat": ["tr1","tr2"] or "repeat": [ ["1","2"] , ...] |
1880 | | (RepList=[array(L1)|_], length(L1,Len) |
1881 | | -> NewRepCount is RepCount+Len, % we have a multi-repeat with list of values to be replaced |
1882 | | LastRepCount is NewRepCount-1, |
1883 | | debug_format(19,' -> Iterating repeat (%~w,...,%~w) over ~w~n',[RepCount,LastRepCount,RepList]), |
1884 | | check_all_same_length_json(RepList,Len,RepPos) |
1885 | | ; NewRepCount is RepCount+1, % next replacement starts at $(RepCount+1) |
1886 | | debug_format(19,' -> Iterating repeat (%~w) over ~w~n',[RepCount,RepList]) |
1887 | | ), |
1888 | ? | ( member(IterElem,RepList), |
1889 | | multi_replace_in_json(IterElem,RepCount,JsonData,ReplacedJsonData), % replace within other for/repeat loops, but also other attributes |
1890 | | process_repeat(NewRepCount,ReplacedJsonData,File,FinalCall), % now process next loop or finish |
1891 | | fail |
1892 | | ; true). |
1893 | | |
1894 | | check_all_same_length_json(List,ExpectedLen,Pos) :- |
1895 | | nth1(Nr,List,Json), |
1896 | | (Json=array(SubList),length(SubList,Len) -> Len \= ExpectedLen ; Len='not a list'), |
1897 | | !, |
1898 | | ajoin(['The element number ',Nr,' of the repeat list has not the expected length of ',ExpectedLen,', length is: '],Msg), |
1899 | | add_warning(visb_visualiser,Msg,Len,Pos). |
1900 | | check_all_same_length_json(_,_,_). |
1901 | | |
1902 | | json_value_to_codes(@(Literal), C) :- atom(Literal), !, atom_codes(Literal, C). |
1903 | | json_value_to_codes(number(Number), C) :- number(Number), !, number_codes(Number, C). |
1904 | | json_value_to_codes(string(String), C) :- atom(String), !, atom_codes(String, C). |
1905 | | json_value_to_codes(Json, _) :- !, add_error(json_value_to_codes,'Cannot convert json term to codes:', Json), fail. |
1906 | | |
1907 | | % replace (possibly) multiple patterns at once |
1908 | | multi_replace_in_json(array([]),_RepCount,JsonIn,JsonOut) :- !, JsonOut=JsonIn. |
1909 | | multi_replace_in_json(array([IterElem|TIT]),RepCount,JsonIn,JsonOut) :- |
1910 | | !, |
1911 | | number_codes(RepCount,Pat), |
1912 | | json_value_to_codes(IterElem,IterElemC), |
1913 | | %format('Replacing in JSON: ~s -> ~s~n',[Pat,IterElemC]), |
1914 | | replace_in_json(Pat,IterElemC,JsonIn,Json), |
1915 | | R1 is RepCount+1, |
1916 | | multi_replace_in_json(array(TIT),R1,Json,JsonOut). |
1917 | | multi_replace_in_json(IterElem,RepCount,JsonIn,JsonOut) :- % a value, not a list |
1918 | | !, |
1919 | | number_codes(RepCount,Pat), |
1920 | | json_value_to_codes(IterElem,IterElemC), |
1921 | | %format('Replacing in JSON: ~s -> ~s~n',[Pat,IterElemC]), |
1922 | | replace_in_json(Pat,IterElemC,JsonIn,JsonOut). |
1923 | | |
1924 | | check_between(_,_,Step,ForPos) :- Step =< 0, !, |
1925 | | add_error(visb_visualiser,'The step of a for loop must be positive:',Step,ForPos),fail. |
1926 | | check_between(From,To,Step,ForPos) :- Iters is (To-From)/Step, |
1927 | | Iters > 100000,!, |
1928 | | add_error(visb_visualiser,'Very large for loop:',Iters,ForPos),fail. |
1929 | | check_between(_,_,_,_). |
1930 | | |
1931 | | |
1932 | | % ---------------- |
1933 | | |
1934 | | % parse and load VisB events |
1935 | | % A VisB Event looks like: |
1936 | | % { |
1937 | | % "id": "button", |
1938 | | % "event": "toggle_button", |
1939 | | % "hovers": [{ "attr":"stroke-width", "enter":"6", "leave":"1"}, |
1940 | | % { "attr":"opacity", "enter":"0.8", "leave":"1.0"}] |
1941 | | % } |
1942 | | process_json_event(File,Json) :- |
1943 | | process_repeat(0,Json,File,add_visb_json_event). |
1944 | | |
1945 | | add_visb_json_event(File,json(List)) :- get_attr_true(ignore,List,File), !. % ignore this item |
1946 | | add_visb_json_event(File,json(List)) :- |
1947 | | get_pos_from_list(List,File,Pos), |
1948 | | force_del_attr(id,List,string(ID),L0,File), % for items it could make sense to not specify an id |
1949 | ? | (del_attr(event,L0,string(Event),L1) -> true ; Event='', L1=L0), |
1950 | | (del_attr_with_pos(predicates,L1,array(Preds),L2,File,PredPos) -> true |
1951 | | ; del_attr_with_pos(preds,L1,array(Preds),L2,File,PredPos) -> true |
1952 | | ; Preds=[], L2=L1, PredPos=unknown), |
1953 | ? | (del_attr(hovers,L2,array(Hovers),L3) -> true ; Hovers=[],L3=L2), |
1954 | | (del_attr(items,L3,array(EI),L4) |
1955 | | -> (empty_b_event(Event) |
1956 | | -> EnableItems=[], |
1957 | | add_warning(visb_visualiser,'Ignoring enable items; you need to provide an event name:',ID,Pos) |
1958 | | ; EnableItems=EI) |
1959 | | ; EnableItems=[],L4=L3), |
1960 | | debug_format(19,' Processing id:~w event:~w preds:~w enable:~w hovers:~w~n',[ID,Event,Preds,EnableItems,Hovers]), |
1961 | | !, |
1962 | | actually_add_visb_json_event(ID,Event,Preds,Hovers,EnableItems,L4,File,Pos,PredPos). |
1963 | | add_visb_json_event(File,Json) :- |
1964 | | !, |
1965 | | get_pos_from_list(Json,File,Pos), |
1966 | | add_error(visb_visualiser,'Illegal VisB Event:',Json,Pos). |
1967 | | |
1968 | | actually_add_visb_json_event(ID,Event,JsonPreds,JsonHovers,JsonEnableItems,JsonList,File,Pos,_PredPos) :- |
1969 | | check_additional_args(JsonList,File), |
1970 | | maplist(process_json_pred,JsonPreds,Preds), |
1971 | | maplist(process_json_enabling_item(ID,Event,File),JsonEnableItems,EnableItems), |
1972 | | maplist(process_json_hover(ID,File),JsonHovers,Hovers), |
1973 | | add_visb_event(ID,Event,Preds,Hovers,EnableItems,File,Pos,JsonList). |
1974 | | |
1975 | | :- use_module(probsrc(tools_strings), [atom_prefix/2]). |
1976 | | :- use_module(probsrc(bmachine), [b_is_operation_name/1]). |
1977 | | add_visb_event(ID,Event,Preds,Hovers,EnableItems,File,Pos,JsonList) :- |
1978 | | (retract(visb_event(ID,OldEvent,OldPreds,OldTypedPred,OldFile,OldPos)) |
1979 | | -> (get_attr_true(override,JsonList,File) |
1980 | | -> ajoin(['Overriding VisB event from file ',OldFile,' for ID: '],Msg), |
1981 | | add_debug_message(visb_visualiser,Msg,ID,Pos), |
1982 | | retractall(visb_hover(ID,_,_,_,_,_)) |
1983 | | ; (OldFile=File |
1984 | | -> ajoin(['No override attribute: adding VisB event ',Event, |
1985 | | ' (first event ',OldEvent,') for ID: '],Msg) |
1986 | | ; ajoin(['No override attribute: adding VisB event ',Event, |
1987 | | ' (first event ',OldEvent,' in file ',OldFile,') for ID: '],Msg) |
1988 | | ), |
1989 | | add_debug_message(visb_visualiser,Msg,ID,Pos), |
1990 | | assertz(auxiliary_visb_event(ID,OldEvent,OldPreds,OldTypedPred,OldPos)) |
1991 | | ), |
1992 | | assert_visb_event(ID,Event,Preds,Hovers,EnableItems,File,Pos) |
1993 | | % ProB2-UI cannot currently support multiple events associated with the same id |
1994 | | % TODO: merge visb_events if we have no override attribute |
1995 | ? | ; b_is_operation_name_or_external_subst(Event) -> |
1996 | | assert_visb_event(ID,Event,Preds,Hovers,EnableItems,File,Pos) |
1997 | | ; (empty_b_event(Event) ; \+ b_or_z_mode) |
1998 | | -> % for empty event we just want hovers |
1999 | | (Preds = [] -> true |
2000 | | ; add_warning(visb_visualiser,'Ignoring preds for VisB event for SVG ID: ',ID,Pos) |
2001 | | ), |
2002 | | assert_visb_event(ID,Event,[],Hovers,EnableItems,File,Pos) |
2003 | | ; get_attr_with_pos(optional,JsonList,_,File,Pos) -> |
2004 | | formatsilent('Ignoring optional VisB event for ~w (lines ~w) due to unknown B operation ~w~n',[ID,Pos,Event]) |
2005 | | ; detect_op_call_with_paras(Event,OpName) -> |
2006 | | add_warning(visb_visualiser,'Ignoring parameters provided in event; use predicate attribute to specify parameters: ',Event,Pos), |
2007 | | assert_visb_event(ID,OpName,Preds,Hovers,EnableItems,File,Pos) |
2008 | | ; atom(Event), atom_prefix('{',Event) -> |
2009 | | ajoin(['Unknown B operation ', Event, ' in VisB for SVG ID (be sure to use events attribute for multiple events): '],Msg), |
2010 | | add_warning(visb_visualiser,Msg,ID,Pos) |
2011 | | ; ajoin(['Unknown B operation ', Event, ' in VisB for SVG ID: '],Msg), |
2012 | | add_warning(visb_visualiser,Msg,ID,Pos) |
2013 | | ). |
2014 | | |
2015 | | b_is_operation_name_or_external_subst(OpName) :- b_is_operation_name(OpName). |
2016 | | b_is_operation_name_or_external_subst(Special) :- special_operation(Special). |
2017 | | |
2018 | | % maybe we should provide those via the external substitution interface: |
2019 | | % these are all schedulers which choose among existing enabled operations in some manner |
2020 | | special_operation('MCTS_AUTO_PLAY'). |
2021 | | special_operation('RANDOM_ANIMATE'). |
2022 | | % maybe other special names like random_animate with nr of steps, LTL until, ... |
2023 | | special_operation_enabled('MCTS_AUTO_PLAY',_,_,_) :- mcts_auto_play_available. |
2024 | | special_operation_enabled('RANDOM_ANIMATE',_,_,_). % TODO: check if a transition exists |
2025 | | |
2026 | | % detect operation call with parameters |
2027 | | detect_op_call_with_paras(Event,OpName) :- atom(Event), |
2028 | | atom_codes(Event,Codes), parse_op_call_name(OpC,Codes,_),!, |
2029 | | atom_codes(OpName,OpC), |
2030 | | b_is_operation_name(OpName). |
2031 | | |
2032 | | parse_op_call_name([X|T]) --> alpha(X), parse_op_call_name2(T). |
2033 | | parse_op_call_name2([]) --> "(". |
2034 | | parse_op_call_name2([H|T]) --> alphadigit(H), parse_op_call_name2(T). |
2035 | | |
2036 | | alpha(X) --> [X],{X>=97, X=<122}. |
2037 | | alphadigit(X) --> [X], ({X>=97,X=<122} ; {X>=65, X=<90} ; {X=95} ; {X>=48, X=<57}). |
2038 | | |
2039 | | empty_b_event(''). |
2040 | | |
2041 | | assert_visb_event(ID,Event,Preds,Hovers,EnableItems,File,Pos) :- |
2042 | | construct_pre_post_predicate(ID,Event,Preds,TypedPred,Pos), |
2043 | | assertz(visb_event(ID,Event,Preds,TypedPred,File,Pos)), |
2044 | | % process hovers |
2045 | ? | (member(HoverElement,Hovers), |
2046 | | (HoverElement=visb_hover(HoverID,Attr,EnterVal,ExitVal) -> true ; add_error(visb_visualiser,'Illegal hover term:',HoverElement),fail), |
2047 | | assert_visb_hover(ID,HoverID,Attr,EnterVal,ExitVal,Pos),fail |
2048 | | ; true), |
2049 | | % now process any additional items with disabled and enabled values |
2050 | | assert_visb_enabling_item_list(Event,TypedPred,EnableItems,File,Pos). |
2051 | | |
2052 | | process_json_pred(string(P),R) :- !, R=P. |
2053 | | process_json_pred(Json,_) :- !, add_error(visb_visualiser,'Illegal json term for predicate:',Json), fail. |
2054 | | |
2055 | | process_json_hover(OriginID,File,json(Hover),visb_hover(ID,Attr,EnterVal,LeaveVal)) :- |
2056 | | force_del_attr(attr,Hover,string(Attr),H2,File), |
2057 | | force_del_attr_with_pos(enter,H2,EV,H3,File,EnterPos), |
2058 | | force_del_attr_with_pos(leave,H3,LV,H4,File,ExitPos), |
2059 | | (is_svg_number_attribute(Attr) % we evaluate number attributes |
2060 | | -> get_number_value(EV,EnterVal,Attr,EnterPos), |
2061 | | get_number_value(LV,LeaveVal,Attr,ExitPos) |
2062 | | ; string(EnterVal)=EV, string(LeaveVal)=LV % return string as is; TODO: also evaluate other attributes |
2063 | | ), |
2064 | | (get_attr(id,H4,string(ID)) -> true ; ID=OriginID). |
2065 | | |
2066 | | |
2067 | | assert_visb_hover(TriggerID,SVG_ID,Attr,EnterVal,ExitVal,Pos) :- |
2068 | | assert(visb_hover(TriggerID,SVG_ID,Attr,EnterVal,ExitVal,Pos)), |
2069 | | (visb_has_hovers(TriggerID) -> true ; assert(visb_has_hovers(TriggerID))), |
2070 | | (visb_has_visibility_hover(SVG_ID) -> true |
2071 | | ; Attr=visibility -> assert(visb_has_visibility_hover(TriggerID)) % object can be made visible by hover |
2072 | | ; true), |
2073 | | debug_format(19,'Adding hover for ~w : ~w.~w -> ~w <- ~w~n',[TriggerID,SVG_ID,Attr,EnterVal,ExitVal]). |
2074 | | |
2075 | | |
2076 | | % process items in event which get translated to enabling/disabling predicates |
2077 | | % "items":[ {"attr":"stroke-width","enabled":"10", "disabled":"1"} ] |
2078 | | process_json_enabling_item(ID,Event,File,json(JsonList), |
2079 | | visb_enable_item(SvgID,Attr,EnabledValExpr,DisabledValExpr,PosAttr)) :- |
2080 | | force_del_attr_with_pos(attr,JsonList,string(Attr),L2,File,PosAttr), |
2081 | | force_del_attr_with_pos('enabled',L2,string(EnVal),L3,File,EPos), |
2082 | | force_del_attr_with_pos('disabled',L3,string(DisVal),L4,File,DPos), |
2083 | | (del_attr(id,L4,string(SvgID),L5) -> true ; SvgID=ID, L4=L5), |
2084 | | atom_codes(EnVal,EC), |
2085 | | parse_expr_for_visb(EC,L5,EPos,EnabledValExpr), |
2086 | | atom_codes(DisVal,DC), |
2087 | | parse_expr_for_visb(DC,L5,DPos,DisabledValExpr), |
2088 | | (debug_mode(off) -> true |
2089 | | ; translate_bexpression_with_limit(EnabledValExpr,30,EVS), |
2090 | | translate_bexpression_with_limit(DisabledValExpr,30,DVS), |
2091 | | formatsilent('Enabling item for event ~w and SVG ID ~w and attribute ~w : ~w <-> ~w~n',[Event,SvgID,Attr,EVS,DVS]) |
2092 | | ). |
2093 | | |
2094 | | assert_visb_enabling_item_list(Event,TypedPred,EnableList,File,Pos) :- |
2095 | | maplist(check_enabling_item(Event),EnableList), |
2096 | | (EnableList \= [] |
2097 | | -> (debug_mode(off) |
2098 | | -> true |
2099 | | ; format('Associating enabling/disabling list with event ~w and predicate: ',[Event]), translate:print_bexpr(TypedPred),nl), |
2100 | | assert(visb_event_enable_list(Event,TypedPred,EnableList,File,Pos)) |
2101 | | ; true). |
2102 | | |
2103 | | check_enabling_item(Event,visb_enable_item(SvgID,Attr,_,_,PosAttr)) :- |
2104 | | (visb_item(SvgID,Attr,_,_,_Desc,DuplicatePos,_) |
2105 | | -> (extract_span_description(DuplicatePos,DuplPos) -> true; DuplPos=DuplicatePos), |
2106 | | ajoin(['VisB conflict for SVG ID ',SvgID,' and attribute ',Attr, |
2107 | | '. Conflict between VisB item (',DuplPos,') and VisB enable/disable entry for event: '],Msg), |
2108 | | add_warning(visb_visualiser,Msg,Event,PosAttr) |
2109 | | ; true). |
2110 | | |
2111 | | valid_additional_attributes(comment). |
2112 | | valid_additional_attributes(description). |
2113 | | valid_additional_attributes(optional). |
2114 | | valid_additional_attributes(override). |
2115 | | |
2116 | | % check if there are additional unprocessed args and generate a warning |
2117 | | check_additional_args(JsonList,File) :- |
2118 | | get_attr_with_pos(Attr,JsonList,_,File,Pos), |
2119 | | \+ valid_additional_attributes(Attr), |
2120 | | add_warning(visb_visualiser,'Ignoring unknown JSON field: ',Attr,Pos), |
2121 | | fail. |
2122 | | check_additional_args(_,_). |
2123 | | |
2124 | | :- use_module(probsrc(bsyntaxtree), [conjunct_predicates/2]). |
2125 | | % construct a pre-post typed predicate for a VisB Event |
2126 | | construct_pre_post_predicate(SvgID,OpName,Preds,TypedPred,Pos) :- |
2127 | | set_error_context(visb_error_context(event,SvgID,OpName,Pos)), |
2128 | | maplist(construct_pre_post_pred(OpName,Pos),Preds,TL), |
2129 | | clear_error_context, |
2130 | | conjunct_predicates(TL,TypedPred). |
2131 | | |
2132 | | :- use_module(probsrc(bmachine), [b_parse_machine_operation_pre_post_predicate/5]). |
2133 | | construct_pre_post_pred(OpName,Pos,PredStr,TypedPred) :- empty_b_event(OpName),!, |
2134 | | add_error(visb_visualiser,'Cannot parse VisB event predicate without event name:',PredStr,Pos), |
2135 | | TypedPred = b(truth,pred,[]). |
2136 | | construct_pre_post_pred(OpName,Pos,String,TypedPred) :- |
2137 | | atom_codes(String,Codes), replace_special_patterns(Codes,RCodes,Pos), %format("Replaced : ~S~n",[RCodes]), |
2138 | | get_visb_extra_scope([identifier(VisBExtraScope)]), |
2139 | | visb_click_meta_b_type(MetaRecType), |
2140 | | ExtraScope = [identifier([b(identifier('VISB_CLICK_META_INFOS'),MetaRecType,[visb_generated])|VisBExtraScope])], |
2141 | | (b_parse_machine_operation_pre_post_predicate(RCodes,ExtraScope,TypedPred,OpName,gen_parse_errors_for(Pos)) |
2142 | | -> true |
2143 | | ; add_error(visb_visualiser,'Error for VisB event predicate:',String,Pos), |
2144 | | TypedPred = b(truth,pred,[]) |
2145 | | ). |
2146 | | |
2147 | | % replace special patterns by dummy values to avoid error messages in ProB2-UI |
2148 | | replace_special_patterns([],[],_Pos) :- !. |
2149 | | replace_special_patterns([37|T],Res,Pos) :- !, % percentage sign % |
2150 | | replace_aux(T,Res,Pos). |
2151 | | replace_special_patterns([H|T],[H|RT],Pos) :- !, replace_special_patterns(T,RT,Pos). |
2152 | | |
2153 | | replace_aux(Input,Res,Pos) :- |
2154 | | replace_pat(PAT,Replacement), |
2155 | | append(PAT,T,Input), |
2156 | | !, |
2157 | | atom_codes(PatAtom,PAT), |
2158 | | ajoin(['The %',PatAtom,' pattern is obsolete. Please use VISB_CLICK_META_INFOS\'',PatAtom,' instead.'],Msg), |
2159 | | add_warning(visb_visualiser,Msg,'',Pos), |
2160 | | append(Replacement,ResT,Res), |
2161 | | replace_special_patterns(T,ResT,Pos). |
2162 | | replace_aux(Input,[37|Res],Pos) :- !, replace_special_patterns(Input,Res,Pos). |
2163 | | |
2164 | | replace_pat("shiftKey","VISB_CLICK_META_INFOS'shiftKey"). |
2165 | | replace_pat("metaKey","VISB_CLICK_META_INFOS'metaKey"). |
2166 | | replace_pat("pageX","VISB_CLICK_META_INFOS'pageX"). |
2167 | | replace_pat("pageY","VISB_CLICK_META_INFOS'pageY"). |
2168 | | |
2169 | | |
2170 | | |
2171 | | % small utils: |
2172 | | % ---------------- |
2173 | | |
2174 | | % a variation of between/3 with a step argument |
2175 | | between(From,To,_,_) :- From > To, !,fail. |
2176 | | between(From,_,_,From). |
2177 | ? | between(From,To,Step,Elem) :- F1 is From+Step, between(F1,To,Step,Elem). |
2178 | | |
2179 | | :- use_module(probsrc(tools_strings),[is_simple_classical_b_identifier_codes/1]). |
2180 | | :- use_module(probsrc(preferences), [reset_temporary_preference/2,temporary_set_preference/3]). |
2181 | | parse_expr(ExprCodes,TypedExpr,_GenParseErrors) :- |
2182 | | is_simple_classical_b_identifier_codes(ExprCodes), |
2183 | | atom_codes(DefID,ExprCodes), |
2184 | | visb_definition(DefID,Type,_DefFormula,Class,_VPos,_), |
2185 | | !, |
2186 | | TypedExpr = b(identifier(DefID),Type,[type_of_formula(Class)]). |
2187 | | parse_expr(ExprCodes,TypedExpr,GenParseErrors) :- |
2188 | | temporary_set_preference(allow_arith_operators_on_reals,true,CHNG), |
2189 | | get_visb_extra_scope(ExtraScope), |
2190 | | % formatsilent('Parsing: ~s (extra ids: ~w)~n',[ExprCodes,ExtraScope]), start_ms_timer(T1), |
2191 | | call_cleanup(bmachine:b_parse_machine_expression_from_codes_with_prob_ids(ExprCodes,ExtraScope,TypedExpr, |
2192 | | GenParseErrors), |
2193 | | reset_temporary_preference(allow_arith_operators_on_reals,CHNG)). |
2194 | | %stop_ms_walltimer_with_msg(T1,'parsing: '). |
2195 | | % TODO: we could share a machine parameter M like in prob2_interface |
2196 | | % so that b_type_expression_for_full_b_machine will load machine only once |
2197 | | % cf b_type_open_predicate_for_full_b_machine |
2198 | | |
2199 | | determine_type_of_visb_formula(b(_,_,[type_of_formula(Class)]),all,Res) :- !, |
2200 | | Res = Class. % generated by VisB, TODO: store UsedTIds in type_of_formula(.) |
2201 | | determine_type_of_visb_formula(TypedExpr,TIds,Class) :- |
2202 | | determine_type_of_formula_with_visb_defs(TypedExpr,TIds,Class). |
2203 | | |
2204 | | %check for used_ids inside TypedExpr an see what type of visb_definition are used |
2205 | | determine_type_of_formula_with_visb_defs(TypedExpr,TIds,ResClass) :- |
2206 | | determine_type_of_formula(TypedExpr,TIds,Class1), % compute class w/o knowledge of VisB definitions |
2207 | ? | (class_more_general_than(Class2,Class1), |
2208 | ? | required_by_visb_def(TIds,Class2) -> Class=Class2 |
2209 | | ; Class=Class1), |
2210 | | (Class=requires_variables -> ResClass=Class |
2211 | | ; expression_requires_state(TypedExpr) -> ResClass = requires_variables |
2212 | | ; ResClass=Class). |
2213 | | |
2214 | | :- use_module(probsrc(bsyntaxtree),[map_over_bexpr/2]). |
2215 | | :- use_module(probsrc(external_functions),[external_function_requires_state/1]). |
2216 | | expression_requires_state(TypedExpr) :- |
2217 | | (map_over_bexpr(sub_expression_requires_state,TypedExpr) -> true ; fail). |
2218 | | % TODO: should we also check is_not_declarative/1 ? e.g., for RANDOM or CHANGED |
2219 | | sub_expression_requires_state(external_pred_call(P,_)) :- external_function_requires_state(P). |
2220 | | sub_expression_requires_state(external_function_call(P,_)) :- external_function_requires_state(P). |
2221 | | |
2222 | | |
2223 | | class_more_general_than(requires_variables,requires_nothing). |
2224 | | class_more_general_than(requires_variables,requires_constants). |
2225 | | class_more_general_than(requires_constants,requires_nothing). |
2226 | | |
2227 | | required_by_visb_def(TIds,Class) :- |
2228 | ? | member(TID,TIds), get_texpr_id(TID,ID),visb_definition(ID,_,_,Class,_,_). |
2229 | | |
2230 | | |
2231 | | get_visb_extra_scope([identifier(ExtraIDs)]) :- |
2232 | | get_visb_extra_identifiers(ExtraIDs). |
2233 | | get_visb_extra_identifiers(ExtraIDs) :- |
2234 | | findall(b(identifier(ID),Type,[visb_generated]),visb_definition(ID,Type,_,_,_,_),ExtraIDs). |
2235 | | |
2236 | | % replace a pattern code prefixed by % by another code list |
2237 | | replace_in_json(Pattern,RepStr,string(Val),string(NewVal)) :- !, replace_atom(Pattern,RepStr,Val,NewVal). |
2238 | | replace_in_json(Pattern,RepStr,array(Vals),array(NewVals)) :- !, maplist(replace_in_json(Pattern,RepStr),Vals,NewVals). |
2239 | | replace_in_json(Pattern,RepStr,json(Vals),json(NewVals)) :- !, maplist(replace_in_json_pair(Pattern,RepStr),Vals,NewVals). |
2240 | | replace_in_json(_,_,Val,Val). % number/literal (no replacement necessary) |
2241 | | |
2242 | | replace_in_json_pair(Pattern,RepStr,'='(KIn,VIn,Pos),'='(KOut,VOut,Pos)) :- |
2243 | | replace_atom(Pattern,RepStr,KIn,KOut), |
2244 | | replace_in_json(Pattern,RepStr,VIn,VOut). |
2245 | | |
2246 | | replace_atom(Pattern,RepStr,Val,NewVal) :- |
2247 | | atom_codes(Val,Codes), |
2248 | | replace_pat(Pattern,RepStr,NewCodes,Codes,[]), |
2249 | | atom_codes(NewVal,NewCodes). % TO DO: keep as codes for efficiency |
2250 | | |
2251 | | :- assert_must_succeed((visb_visualiser: replace_pat("0","_1_",Res,"ab%0cd",[]), Res == "ab_1_cd")). |
2252 | | :- assert_must_succeed((visb_visualiser: replace_pat("0","",Res,"ab%0%0cd%0",[]), Res == "abcd")). |
2253 | | % dcg utility to replace %Pat by NewStr constructing Res |
2254 | | replace_pat(Pat,NewStr,Res) --> "%", Pat, !, {append(NewStr,TR,Res)}, replace_pat(Pat,NewStr,TR). |
2255 | | replace_pat(Pat,RepStr,[H|T]) --> [H],!, replace_pat(Pat,RepStr,T). |
2256 | | replace_pat(_,_,[]) --> []. |
2257 | | |
2258 | | |
2259 | | % small JSON utils: |
2260 | | % ---------------- |
2261 | | |
2262 | ? | get_attr(Attr,List,Val) :- member('='(Attr,Val,_),List). |
2263 | | get_attr_with_pos(Attr,List,Val,File,Pos) :- |
2264 | | El = '='(Attr,Val,_), |
2265 | ? | member(El,List), |
2266 | | get_pos_from_list([El],File,Pos). |
2267 | | |
2268 | ? | del_attr(Attr,List,Val,Rest) :- select('='(Attr,Val,_Pos),List,Rest). |
2269 | | %del_attr_with_pos(Attr,List,Val,Rest,Pos) :- select('='(Attr,Val,Pos),List,Rest). |
2270 | ? | del_attr_with_pos(Attr,List,Val,Rest,File,PosTerm) :- select('='(Attr,Val,From-To),List,Rest),!, |
2271 | | PosTerm = src_position_with_filename_and_ec(From,1,To,1,File). |
2272 | ? | non_det_del_attr_with_pos(Attr,List,Val,Rest,File,PosTerm) :- select('='(Attr,Val,From-To),List,Rest), |
2273 | | PosTerm = src_position_with_filename_and_ec(From,1,To,1,File). |
2274 | | |
2275 | | force_del_attr(Attr,List,Val,Rest,File) :- force_del_attr_with_pos(Attr,List,Val,Rest,File,_). |
2276 | | |
2277 | ? | force_del_attr_with_pos(Attr,List,Val,Rest,File,PosTerm) :- select('='(Attr,Val,From-To),List,Rest),!, |
2278 | | %TODO: we would ideally want to extract the exact column position of Val, for this we need to extend the JSON parser first |
2279 | | PosTerm = src_position_with_filename_and_ec(From,1,To,1,File). |
2280 | | force_del_attr_with_pos(Attr,List,_,_,File,_) :- get_pos_from_list(List,File,Pos),!, |
2281 | | add_error(visb_visualiser,'The JSON object has no attribute:',Attr,Pos),fail. |
2282 | | |
2283 | | construct_prob_pos_term(From-To,File,PosTerm) :- !, |
2284 | | PosTerm = src_position_with_filename_and_ec(From,1,To,1,File). |
2285 | | construct_prob_pos_term(Pos,_,Pos). |
2286 | | |
2287 | | force_get_attr_nr(Attr,List,Nr,File) :- |
2288 | | force_del_attr_with_pos(Attr,List,AttrVal,_,File,Pos),!, |
2289 | | get_number_value(AttrVal,Nr,Attr,Pos). |
2290 | | |
2291 | | get_number_value(AttrVal,Nr,Attr,Pos) :- |
2292 | | (AttrVal = number(Nr) -> true |
2293 | | ; AttrVal = string(StrAttrVal), |
2294 | | atom_codes(StrAttrVal,AttrValC), |
2295 | | parse_expr(AttrValC,TypedExpr,gen_parse_errors_for(Pos)), |
2296 | | determine_type_of_visb_formula(TypedExpr,UsedTIds,Class) |
2297 | | % Class = requires_nothing, requires_constants, requires_variables |
2298 | | -> |
2299 | | (Class = requires_variables |
2300 | | -> ajoin(['The JSON formula for the attribute"',Attr, |
2301 | | '" must not depend on variables:'],Msg), |
2302 | | add_error(visb_visualiser,Msg,StrAttrVal,Pos),fail |
2303 | | ; Class = requires_constants, |
2304 | | \+ is_concrete_constants_state_id(_) |
2305 | | -> ajoin(['The JSON formula for the attribute"',Attr, |
2306 | | '" depends on constants which have not been set up (via SETUP_CONSTANTS):'],Msg), |
2307 | | add_error(visb_visualiser,Msg,StrAttrVal,Pos),fail |
2308 | | ; Class = requires_constants, |
2309 | | multiple_concrete_constants_exist, |
2310 | | ajoin(['The JSON formula for the attribute"',Attr, |
2311 | | '" depends on constants and multiple solutions for SETUP_CONSTANTS exist:'],Msg), |
2312 | | add_warning(visb_visualiser,Msg,StrAttrVal,Pos),fail |
2313 | | ; get_texpr_type(TypedExpr,Type), |
2314 | | is_number_type(Type) |
2315 | | -> eval_static_def(Class,'VisB attribute',Attr,TypedExpr,UsedTIds,ResVal,Pos), |
2316 | | get_number_from_bvalue(ResVal,Nr) |
2317 | | ; get_texpr_type(TypedExpr,Type), |
2318 | | % it could produce a string which is a number; we could try and convert to a number |
2319 | | ajoin(['The type ',Type,' of the JSON value formula for the attribute "',Attr, |
2320 | | '" is not a number:'],Msg), |
2321 | | add_error(visb_visualiser,Msg,StrAttrVal,Pos),fail |
2322 | | ) |
2323 | | ; ajoin(['The JSON value for the attribute "',Attr,'" cannot be parsed as a number:'],Msg), |
2324 | | add_error(visb_visualiser,Msg,AttrVal,Pos),fail). |
2325 | | |
2326 | | is_number_type(integer). |
2327 | | is_number_type(real). |
2328 | | :- use_module(probsrc(kernel_reals),[is_real/2]). |
2329 | | :- use_module(probsrc(custom_explicit_sets),[singleton_set/2]). |
2330 | | get_number_from_bvalue(int(Nr),Res) :- !, Res=Nr. |
2331 | | get_number_from_bvalue(Term,Res) :- is_real(Term,Nr),!,Res=Nr. |
2332 | | |
2333 | | get_pos_from_list(json(List),File,Pos) :- !, get_pos_from_list(List,File,Pos). |
2334 | | get_pos_from_list([H|T],File,RPos) :- |
2335 | | H='='(_,_,From-_), |
2336 | | last([H|T], |
2337 | | '='(_,_,_-To)), |
2338 | | !, |
2339 | | RPos=src_position_with_filename_and_ec(From,1,To,1,File). |
2340 | | get_pos_from_list(_,File,File). % should we provide another term? |
2341 | | |
2342 | | % ---------------------------------- |
2343 | | |
2344 | | :- use_module(probsrc(b_global_sets),[add_prob_deferred_set_elements_to_store/3]). |
2345 | | :- use_module(probsrc(tools),[b_string_escape_codes/2]). |
2346 | | |
2347 | | % computing updates to SVG for a given StateId: |
2348 | | % predicate to obtain required setAttribute changes to visualise StateId |
2349 | | % looks up visb_item facts but also evaluates VISB_SVG_UPDATE definitions |
2350 | | get_change_attribute_for_state(StateId,SvgID,SvgAttribute,Value) :- |
2351 | | set_error_context(checking_context('VisB:','computing attributes for state')), |
2352 | | get_expanded_bstate(StateId,ExpandedBState), |
2353 | | set_context_state(StateId,get_change_attribute_for_state), % also sets it for external functions |
2354 | | % TODO: also set history so that get_current_history in external_functions is more reliable |
2355 | ? | call_cleanup(get_change_aux(StateId,ExpandedBState,SvgID,SvgAttribute,Value), |
2356 | | (clear_context_state,clear_error_context)). |
2357 | | |
2358 | | get_change_aux(StateId,ExpandedBState,SvgID,SvgAttribute,Value) :- |
2359 | ? | get_aux2(StateId,ExpandedBState,SvgID0,SvgAttribute0,Value0,DefPos), |
2360 | | post_process_visb_item(SvgID0,SvgAttribute0,Value0,DefPos,SvgID,SvgAttribute,Value). |
2361 | | get_aux2(StateId,ExpandedBState,SvgID,SvgAttribute,Value,DefPos) :- |
2362 | | % first get updates from DEFINITIONS which usually return sets of records |
2363 | ? | get_svg_object_updates_from_definitions(ExpandedBState,SvgID,SvgAttribute,Value,DefPos), |
2364 | | debug_format(19,' VISB_SVG_UPDATE ~w:~w = ~w (in state ~w)~n',[SvgID,SvgAttribute,Value,StateId]). |
2365 | | get_aux2(StateId,ExpandedBState,SvgID,SvgAttribute,Value,Pos) :- |
2366 | | % TODO: check if visibility item exists, and if value is false: do not compute the rest |
2367 | ? | get_visb_item_formula(SvgID,SvgAttribute,Formula,Pos,ExpandedBState), |
2368 | | % TODO: if UsedIds=[] only set attribute once, if it requires_only_constants : ditto |
2369 | | evaluate_visb_formula(Formula,'VisB item',SvgID,ExpandedBState,FValue,Pos), |
2370 | | %b_value_to_string(FValue,Value), |
2371 | | extract_attr_value(SvgAttribute,FValue,Value,Pos), |
2372 | | debug_format(19,' VisB item ~w:~w = ~w (in state ~w)~n',[SvgID,SvgAttribute,Value,StateId]). |
2373 | | |
2374 | | % post-process certain items, like title to adapt the value and id: |
2375 | | % SVG does not support a title attribute; we need a title child and set its text attribute |
2376 | | post_process_visb_item(SvgID,title,Value,Pos,NewID,text,Value) :- |
2377 | | visb_svg_object(SvgID,_SVG_Class,_RestAttrs,_Desc,_Pos1), |
2378 | ? | (visb_svg_parent(SvgID,TitleID), |
2379 | | visb_svg_object(TitleID,title,_,_,_) |
2380 | | -> NewID=TitleID, |
2381 | | debug_format(9,'Redirecting title update for ~w to child object ~w~n',[SvgID,TitleID]) |
2382 | | ; add_warning(visb_visualiser,'Could not find title child object, be sure to define a static title attribute for SVG object: ',SvgID,Pos), |
2383 | | fail |
2384 | | ),!. |
2385 | | post_process_visb_item(SvgID,Attr,Value,_,SvgID,Attr,Value). |
2386 | | |
2387 | | % ------------------ |
2388 | | |
2389 | | % convert B value to Json String |
2390 | | b_value_to_string(string(SValue),Res) :- !, Res=SValue. % What about quoting,...? |
2391 | | b_value_to_string(FValue,Res) :- |
2392 | | translate_bvalue_to_codes(FValue,ValCodes), |
2393 | | atom_codes(Res,ValCodes). |
2394 | | |
2395 | | % attributes for which we convert pairs to the concatenation of strings |
2396 | | is_id_or_text_attribute(id). |
2397 | | is_id_or_text_attribute('group_id'). % works much like a parent_id; also can be used to attach animate to e.g. a rect |
2398 | | is_id_or_text_attribute('trigger_id'). |
2399 | | is_id_or_text_attribute('trigger-id'). |
2400 | | is_id_or_text_attribute(A) :- is_text_attribute(A). |
2401 | | % children |
2402 | | is_text_attribute('text'). |
2403 | | is_text_attribute('transform'). |
2404 | | is_text_attribute('event'). % for VISB_SVG_EVENTS |
2405 | | is_text_attribute('predicate'). % for VISB_SVG_EVENTS |
2406 | | is_text_attribute('svg_class'). |
2407 | | |
2408 | | |
2409 | | b_value_to_id_string(Val,String) :- b_val_to_id_string_aux(Val,add_underscore,String). |
2410 | | b_value_to_text_string(Val,String) :- b_val_to_id_string_aux(Val,no_underscore,String). |
2411 | | |
2412 | | % a special string conversion which e.g., allows to use things like ("ab",2) as id which gets translated to ab2 |
2413 | | % also useful for text attributes |
2414 | | b_val_to_id_string_aux(string(SValue),_,Res) :- !, Res=SValue. |
2415 | | b_val_to_id_string_aux((A,B),Add,Res) :- !, |
2416 | | b_val_to_id_string_aux(A,Add,VA), b_val_to_id_string_aux(B,Add,VB), |
2417 | | (Add=add_underscore |
2418 | | -> atom_concat('_',VB,VB1) % introduce separator; in case we have things like numbers so that (12,3) /= (1,23) |
2419 | | ; VB1=VB % for fields like predicate, transform, ... we do not want additional underscores |
2420 | | ), |
2421 | | atom_concat(VA,VB1,Res). |
2422 | | b_val_to_id_string_aux(Set,Add,Res) :- singleton_set(Set,El),!, b_val_to_id_string_aux(El,Add,Res). |
2423 | | % TODO: maybe convert sequence of values using conc |
2424 | | b_val_to_id_string_aux(FValue,_,Res) :- |
2425 | | translate_bvalue_to_codes(FValue,ValCodes), |
2426 | | atom_codes(Res,ValCodes). |
2427 | | |
2428 | | % get either a regular VisB item or an item associated with a VisB event and its enabled status |
2429 | | get_visb_item_formula(SvgID,SvgAttribute,Formula,Pos,_ExpandedBState) :- |
2430 | ? | visb_item(SvgID,SvgAttribute,Formula,_UsedIds,_Desc,Pos,_). % regular VisB item |
2431 | | get_visb_item_formula(SvgID,SvgAttribute,Formula,Pos,ExpandedBState) :- % item within VisB event |
2432 | | visb_event_enable_list(OpName,TypedPred,EnableList,_,ItemPos), |
2433 | | debug_format(19,'Checking enabledness of VisB event ~w~n',[OpName]), |
2434 | | (check_enabled(OpName,TypedPred,ExpandedBState,ItemPos) |
2435 | | -> Formula=EnabledValExpr |
2436 | | ; Formula=DisabledValExpr |
2437 | | ), |
2438 | | member(visb_enable_item(SvgID,SvgAttribute,EnabledValExpr,DisabledValExpr,Pos), EnableList). |
2439 | | |
2440 | | check_enabled(OpName,Pred,ExpandedBState,Pos) :- |
2441 | | special_operation(OpName),!, |
2442 | | special_operation_enabled(OpName,Pred,ExpandedBState,Pos). |
2443 | | check_enabled(OpName,Pred,ExpandedBState,Pos) :- |
2444 | | b_is_operation_name(OpName), |
2445 | | % TODO: see if we can use GUARD without execution |
2446 | | execute_operation_by_predicate_in_state_with_pos(ExpandedBState,OpName,Pred,_OpTerm,_NewState,Pos). |
2447 | | |
2448 | | |
2449 | | get_expanded_bstate(StateId,ExpandedBState) :- |
2450 | | \+ b_or_z_mode,!, |
2451 | | StateId \= root, |
2452 | | % in XTL mode we need to access the state via external functions like STATE_PROPERTY |
2453 | | get_static_visb_state([],ExpandedBState). |
2454 | | get_expanded_bstate(StateId,ExpandedBState) :- |
2455 | | visited_expression(StateId,State), |
2456 | | state_corresponds_to_initialised_b_machine(State,BState), |
2457 | | debug_format(19,'Adding VisB definitions to state: ~w~n',[StateId]), |
2458 | | add_prob_deferred_set_elements_to_store(BState,BState2,visible), % add prob_ids |
2459 | | findall(visb_definition(DefID,Type,DefFormula,Class,VPos,Special), |
2460 | | visb_definition(DefID,Type,DefFormula,Class,VPos,Special),DefList), |
2461 | | eval_defs(DefList,BState2,ExpandedBState). |
2462 | | |
2463 | | |
2464 | | :- use_module(probsrc(b_interpreter), [ b_compute_expression_nowf/7,b_compute_explicit_epression_no_wf/7]). |
2465 | | |
2466 | | evaluate_static_visb_formula(Formula,Kind,Nr,InState,ResValue,Pos) :- |
2467 | | get_static_visb_state(InState,StaticState), |
2468 | | evaluate_visb_formula(Formula,Kind,Nr,StaticState,ResValue,Pos). |
2469 | | |
2470 | | evaluate_visb_formula(Formula,Kind,Nr,BState2,ResValue,Pos) :- |
2471 | | % add_message(visb,'Evaluating: ',Kind:Nr,Pos), debug:nl_time, %set_prolog_flag(profiling,on), print_profile, |
2472 | ? | (b_compute_explicit_epression_no_wf(Formula,[],BState2,ResValue,Kind,Nr,Pos) -> true |
2473 | | ; add_error(visb_visualiser,'Evaluation of VisB formula failed:',Formula,Pos), |
2474 | | fail). |
2475 | | |
2476 | | % evaluate VisB definitions in order one by one, adding values to state |
2477 | | eval_defs([],State,State). |
2478 | | eval_defs([visb_definition(ID,_,TypedExpr,_Class,VPos,Special)|T],State0,State2) :- |
2479 | | (Special \= regular_def |
2480 | | -> State1=State0 % ignore special defs; they are processed separately |
2481 | | ; b_compute_expression_nowf(TypedExpr,[],State0,ResValue,'VisB definition',ID,VPos), |
2482 | | State1 = [bind(ID,ResValue)|State0], % store value for later definitions and VisB items |
2483 | | (debug_mode(off) -> true |
2484 | | ; translate_bvalue_to_codes_with_limit(ResValue,2000,RC), |
2485 | | formatsilent(' VisB definition ~w == ~s~n',[ID,RC])) |
2486 | | ), |
2487 | | eval_defs(T,State1,State2). |
2488 | | |
2489 | | % check if we have a static value for a VisB definition: |
2490 | | visb_def_static_value(DefID,Value) :- |
2491 | ? | visb_definition(DefID,_,b(value(Value),_,_),Class,_,SpecialClass), |
2492 | | SpecialClass = regular_def, |
2493 | | (Class = requires_nothing ; Class = requires_constants). % probably we do not need to check this, as we have value/1 |
2494 | | |
2495 | | get_static_visb_state(InState,FullState) :- |
2496 | | findall(bind(DefID,Value),visb_def_static_value(DefID,Value),FullState,InState). |
2497 | | % TO DO: get state with deferred_set_elements,... |
2498 | | |
2499 | | % ---------------------------------- |
2500 | | |
2501 | | % generate a stand-alone HTML file with a visualisation for all states in the list |
2502 | | |
2503 | | generate_visb_html(StateIds,File,Options) :- |
2504 | | safe_open_file(File,write,Stream,[encoding(utf8)]), |
2505 | | generate_html_to_stream(StateIds,Stream,[html_file/File|Options]), |
2506 | | close(Stream). |
2507 | | |
2508 | | generate_visb_html_to_codes(StateIds,Options,Codes) :- |
2509 | | with_open_stream_to_codes( |
2510 | | generate_html_to_stream(StateIds,Stream,Options), |
2511 | | Stream,Codes,[]). |
2512 | | |
2513 | | |
2514 | | % generate an HTML file to visualise the given StateId |
2515 | | generate_html_to_stream(StateIds,Stream,Options) :- |
2516 | | set_id_namespace_prefix_for_states(StateIds,Options), |
2517 | | write_visb_template('visb_template_header.html',Stream), |
2518 | | (member(show_svg_downloads,Options) -> write_visb_template('visb_template_svg_downloads.html',Stream) ; true), |
2519 | | format(Stream,' <script>~n',[]), |
2520 | | retractall(js_generated_function(_)), |
2521 | | length(StateIds,Len), |
2522 | | format(Stream,' const differences = [~n',[]), |
2523 | | maplist(gen_visb_visualise_function(Stream,Options,Len,StateIds),StateIds), |
2524 | | write_visb_template('visb_template_replayTrace.html',Stream), |
2525 | | format(Stream,' </script>~n~n',[]), |
2526 | | gen_registerHovers_scipt(Stream,Options), |
2527 | | write_visb_template('visb_template_middle.html',Stream), |
2528 | | (no_svg_available |
2529 | | -> format(Stream,' <button type="button" class="collapsible-style">No SVG Visualisation Available</button>~n',[]) |
2530 | | ; % generate SVG section |
2531 | | (member(no_header,Options) -> true |
2532 | | ; format(Stream,' <button type="button" class="collapsible collapsible-style active">SVG Visualisation</button>~n',[]) |
2533 | | ), |
2534 | | format(Stream,' <div style="position: relative;">~n',[]), % container for SVG download buttons |
2535 | | format(Stream,' <div text-align="left" id="visb_svg_outer_container" class="svg-outer-container">~n',[]), |
2536 | | format(Stream,' <div id="visb_svg_inner_container" class="svg-inner-container">~n',[]), |
2537 | | %format(Stream,' <fieldset> <legend>Visualisation:</legend>~n',[]), % comment in to draw a border |
2538 | | (StateIds = [SingleStateId] -> GenForState=SingleStateId ; GenForState=root), |
2539 | | copy_svg_file_and_gen_objects(Stream,GenForState,_SVGinlined), |
2540 | | % TO DO: avoid creating JS code below if _SVGinlined |
2541 | | %format(Stream,' </fieldset>~n',[]), |
2542 | | format(Stream,' </div>~n',[]), % inner container |
2543 | | format(Stream,' </div>~n',[]), % outer container |
2544 | | format(Stream,' <button id="btnResetScale" class="visualisation-button" onclick="resetScale()">Reset View</button>~n',[]), |
2545 | | (member(show_svg_downloads,Options) -> |
2546 | | format(Stream,' <button onclick="downloadSVG()">Save SVG (Current State)</button>~n',[]), |
2547 | | format(Stream,' <button onclick="downloadAllSVGs()">Save all SVGs</button>~n',[]) |
2548 | | ; true), |
2549 | | format(Stream,' </div>~n',[]) % container for SVG download buttons |
2550 | | ), |
2551 | | (Len>1, memberchk(show_sequence_chart,Options) % don't export PlantUML for list of state IDs (sequence chart depends on trace) |
2552 | | -> (create_temp_puml_files(Len,Files), |
2553 | | uml_generator:write_uml_sequence_chart_all_states(Files), % generate .puml files |
2554 | | tools_commands:gen_plantuml_output(Files,svg,[]) % generate .svg files |
2555 | | -> format(Stream,' <button type="button" class="collapsible collapsible-style active">Sequence Chart Visualisation</button>~n',[]), |
2556 | | format(Stream,' <div class="seq-chart-container">~n',[]), |
2557 | | reverse(Files,RFiles), |
2558 | | write_temp_puml_outputs(1,RFiles,Stream), % write SVG contents to HTML |
2559 | | format(Stream,' </div>~n',[]) |
2560 | | ; add_warning(visb_visualiser,'HTML export: did not write the Sequence Diagram Visualisation due to an error in the PlantUML call.'), |
2561 | | format(Stream,' <button type="button" class="collapsible-style">No Sequence Chart Visualisation Available</button>~n',[]) |
2562 | | ) |
2563 | | ; true), |
2564 | | (Len>1 |
2565 | | -> %format(Stream,'~n<h3>Run Trace</h3>~n',[]), |
2566 | | format(Stream,' <button type="button" class="collapsible-style">Replay Trace</button>~n',[]), |
2567 | | format(Stream,' <div class="coll-content-vis">~n',[]), |
2568 | | format(Stream,' <button id="btnPrev" onclick="backStep()" title="Go back one step">« Back</button>~n',[]), |
2569 | | format(Stream,' <button id="btnNext" onclick="forwardStep()" title="Go forward one step">Forward »</button>~n',[]), |
2570 | | format(Stream,' <button onclick="runAll(10)" title="Fast replay of entire trace">Run Trace (10 ms delay)</button>~n',[]), |
2571 | | format(Stream,' <button onclick="runAll(500)" title="Slow replay of entire trace">Run Trace (500 ms delay)</button>~n',[]), |
2572 | | % We could decide to provide an option/preference for generating the visb_debug_messages field: |
2573 | | % (check that ProB2-UI also generates this text field) |
2574 | | format(Stream,' <br><label id="visb_debug_messages" class="visb-messages"> </label>~n',[]), |
2575 | | format(Stream,' </div>~n',[]), |
2576 | | format(Stream,' <progress id="trace_meter" min="0" max="~w" value="0"></progress>~n',[Len]) % progress of trace replay; note <meter> element also works |
2577 | | ; true |
2578 | | ), |
2579 | | % generate a table with variables, constants, ... |
2580 | | gen_state_table(Stream,Options,StateIds), |
2581 | | gen_source_code_section(Stream,Options), |
2582 | | % generate a table with the saved trace steps: |
2583 | | (Len>1 -> gen_trace_table(Stream,StateIds) ; true), |
2584 | | write_version_info(Stream,Options), |
2585 | | (last(StateIds,_) |
2586 | | -> format(Stream,' <script> replayStep(~w); </script>~n',[Len]) |
2587 | | % show the visualisation of the last state by default |
2588 | | ; true % trace is empty, there is no last item |
2589 | | ), |
2590 | | write_visb_template('visb_template_footer.html',Stream), |
2591 | | clear_id_namespace_prefix. |
2592 | | |
2593 | | write_file_to_stream(File,Stream) :- |
2594 | | safe_open_file(File,read,StreamIn,[encoding(utf8)]), |
2595 | | copy_stream(StreamIn,Stream), |
2596 | | close(StreamIn). |
2597 | | |
2598 | | create_temp_puml_files(Len,[]) :- Len<1, !. |
2599 | | create_temp_puml_files(Len,[Path|T]) :- |
2600 | | system_call:get_temporary_filename('for_html.puml',Path), |
2601 | | NewLen is Len-1, |
2602 | | create_temp_puml_files(NewLen,T). |
2603 | | |
2604 | | write_temp_puml_outputs(_,[],_). |
2605 | | write_temp_puml_outputs(Nr,[File|T],Stream) :- |
2606 | | tools:split_filename(File,FileRoot,_Ext), |
2607 | | ajoin([FileRoot,'.svg'],SvgFile), |
2608 | | format(Stream,' <div id="seq_chart_~w" style="display:none">~n',[Nr]), % container for seq. charts |
2609 | | write_file_to_stream(SvgFile,Stream), |
2610 | | format(Stream,' </div>~n',[]), % container for seq. charts |
2611 | | NNr is Nr+1, |
2612 | | write_temp_puml_outputs(NNr,T,Stream). |
2613 | | |
2614 | | % ----------------- |
2615 | | |
2616 | | :- use_module(library(system),[ datime/1]). |
2617 | | :- use_module(probsrc(tools_strings),[number_codes_min_length/3]). |
2618 | | :- use_module(probsrc(tools),[gen_relative_path/3]). |
2619 | | :- use_module(probsrc(version),[version_str/1]). |
2620 | | :- use_module(probsrc(specfile),[currently_opened_file/1, get_internal_representation/1]). |
2621 | | write_version_info(_,Options) :- |
2622 | | member(no_version_info,Options),!. |
2623 | | write_version_info(Stream,Options) :- |
2624 | | version_str(Str),datime(datime(Yr,Mon,Day,Hr,Min,_Sec)), |
2625 | | number_codes_min_length(Min,2,MC), |
2626 | | format(Stream,' <button type="button" class="collapsible-style" title="Information about ProB and model">Info</button>~n',[]), |
2627 | | format(Stream,'<div class="coll-content-vis visb-messages">~n',[]), |
2628 | | format(Stream,'Generated on ~w/~w/~w at ~w:~s using <a href="https://prob.hhu.de/">ProB</a> version ~w~n',[Day,Mon,Yr,Hr,MC,Str]), |
2629 | | (currently_opened_file(File) |
2630 | | -> (File=package(Type) -> |
2631 | | format(Stream,'<br>Main specification package: ~w~n',[Type]) |
2632 | | ; atom(File), get_relative_path(File,Options,Suffix) -> |
2633 | | format(Stream,'<br>Main specification file: ~w',[Suffix]), |
2634 | | format_file_info(Stream,File) |
2635 | | ; format(Stream,'<br>Unknown main specification file: ~w~n',[File]) |
2636 | | ) |
2637 | | ; true), |
2638 | | (b_machine_name(MainName) |
2639 | | -> format(Stream,'<br>Main specification name: ~w~n',[MainName]) ; true), |
2640 | | (visb_file_loaded(JSONFile,_,ModLocTime), |
2641 | | JSONFile \= '' |
2642 | | -> get_relative_path(JSONFile,Options,JSuffix), |
2643 | | format(Stream,'<br>Main VisB JSON file: ~w',[JSuffix]), |
2644 | | format_modified_info(Stream,ModLocTime), |
2645 | | (get_non_empty_svg_file(SVGFile,ModLocTime2) |
2646 | | -> get_relative_path(SVGFile,Options,SSuffix), |
2647 | | format(Stream,'<br>VisB SVG file: ~w',[SSuffix]), |
2648 | | format_modified_info(Stream,ModLocTime2) |
2649 | | ; true |
2650 | | ) |
2651 | | ; true). |
2652 | | |
2653 | | get_non_empty_svg_file(SVGFile,ModLocTime2) :- |
2654 | | visb_svg_file(RelFile,SVGFile,_,_,ModLocTime2), |
2655 | | RelFile \= ''. |
2656 | | |
2657 | | format_file_info(Stream,File) :- |
2658 | | catch(file_property(File, modify_localtime, ModLocTime), |
2659 | | E, |
2660 | | (add_message(visb_visualiser,'Could not obtain modification time for file: ',E), fail)), |
2661 | | !, |
2662 | | format_modified_info(Stream,ModLocTime). |
2663 | | format_file_info(Stream,_) :- nl(Stream). |
2664 | | |
2665 | | format_modified_info(Stream,ModLocTime) :- |
2666 | | format(Stream,' (modified on ',[]), |
2667 | | format_datime(Stream,ModLocTime), |
2668 | | format(Stream,')~n',[]). |
2669 | | |
2670 | | format_datime(Stream,datime(Yr,Mon,Day,Hr,Min,_Sec)) :- |
2671 | | number_codes_min_length(Min,2,MC), |
2672 | | format(Stream,'~w/~w/~w at ~w:~s',[Day,Mon,Yr,Hr,MC]). |
2673 | | |
2674 | | get_relative_path(File,Options,RelPath) :- |
2675 | ? | member(html_file/HF,Options), |
2676 | | absolute_file_name(File,AF,[]), |
2677 | | absolute_file_name(HF,AHF,[]), |
2678 | | !, |
2679 | | gen_relative_path(AF,AHF,RelPath). % only print relative information |
2680 | | get_relative_path(File,_,File). |
2681 | | |
2682 | | |
2683 | | % ----------------- |
2684 | | |
2685 | | % gen a table with all the individual steps of the trace |
2686 | | gen_trace_table(Stream,StateIds) :- |
2687 | | length(StateIds,Len), |
2688 | | %format(Stream,'~n<h3>Trace (length=~w)</h3>~n',[Len]), |
2689 | | format(Stream,' <button type="button" class="collapsible collapsible-style active">Trace (length=~w)</button>~n',[Len]), |
2690 | | format(Stream,'<div class="coll-content-vis">~n',[]), |
2691 | ? | (member(Obj,StateIds), get_state_and_action(Obj,_,_,DescStr), DescStr \= '' |
2692 | | -> Opt=with_description ; Opt=no_description), |
2693 | | gen_trace_table2(Stream,StateIds,Opt). |
2694 | | |
2695 | | gen_trace_table2(Stream,StateIds,no_description) :- |
2696 | | format(Stream,' <table> <tr> <th>Nr</th> <th>Event</th> <th>Target State ID</th> </tr>~n',[]), |
2697 | ? | nth1(Nr,StateIds,Obj), |
2698 | | get_state_and_action(Obj,StateId,ActionStr,_), |
2699 | | (visited_state_corresponds_to_initialised_b_machine(StateId) |
2700 | | -> (invariant_violated(StateId) -> BtnStyle='style="background-color:rgb(255,179,179);border-radius:6px" ' ; BtnStyle=''), |
2701 | | format(Stream,'~n <tr id="row~w" onclick="replayStep(~w)"><td>~w</td><td style="cursor:pointer">~w</td><td><button ~wonclick="replayStep(~w);">State ~w</button></td></tr>~n', |
2702 | | [Nr,Nr,Nr,ActionStr,BtnStyle,Nr,StateId]) |
2703 | | ; format(Stream,'~n <tr id="row~w"><td>~w</td><td style="cursor:not-allowed">~w</td><td>State ~w</td></tr>~n', |
2704 | | [Nr,Nr,ActionStr,StateId]) |
2705 | | ), |
2706 | | fail. |
2707 | | gen_trace_table2(Stream,StateIds,with_description) :- |
2708 | | format(Stream,' <table> <tr> <th>Nr</th> <th>Event</th> <th>Description</th> <th>Target State ID</th> </tr>~n',[]), |
2709 | ? | nth1(Nr,StateIds,Obj), |
2710 | | get_state_and_action(Obj,StateId,ActionStr,DescStr), |
2711 | | atom_codes(ActionStr,ActionCodes),html_escape_codes(ActionCodes,EAS), |
2712 | | atom_codes(DescStr,DescCodes),html_escape_codes(DescCodes,EDS), |
2713 | | (visited_state_corresponds_to_initialised_b_machine(StateId) |
2714 | | -> (invariant_violated(StateId) -> BtnStyle='style="background-color:rgb(255,179,179);border-radius:6px" ' ; BtnStyle=''), |
2715 | | format(Stream,'~n <tr id="row~w" onclick="replayStep(~w)"><td>~w</td><td style="cursor:pointer">~s</td><td>~s</td><td><button ~wonclick="replayStep(~w);">State ~w</button></td></tr>~n', |
2716 | | [Nr,Nr,Nr,EAS,EDS,BtnStyle, Nr,StateId]) |
2717 | | ; format(Stream,'~n <tr id="row~w"><td>~w</td><td style="cursor:not-allowed">~s</td><td>~s</td><td>State ~w</td></tr>~n', |
2718 | | [Nr,Nr,EAS,EDS,StateId]) |
2719 | | ), |
2720 | | fail. |
2721 | | gen_trace_table2(Stream,_,_) :- |
2722 | | format(Stream,' </table>~n </div>~n',[]). |
2723 | | |
2724 | | |
2725 | | % utility to allow passing information about name of event/operation/action leading to state |
2726 | | get_state_and_action(change_to_state_via_action(StateId,ActionStr,DescStr),StateId,ActionStr,DescStr) :- !. |
2727 | | get_state_and_action(StateId,StateId,'',''). |
2728 | | |
2729 | | % ----------------- |
2730 | | |
2731 | | % inline provided svg file into html file: |
2732 | | % second argument is either root or a particular state id for which the SVG file is to be created |
2733 | | % the last argument is static_svg_inlined if all SVG objects were "inlined" into a single |
2734 | | % SVG object (rather than via JavaScript functions to create the objects) |
2735 | | copy_svg_file_and_gen_objects(Stream,_,static_svg_not_inlined) :- visb_svg_file(_,File,_,_,_), file_exists(File), |
2736 | | !, |
2737 | | write_file_to_stream(File,Stream), |
2738 | | ( get_visb_contents_def(Contents,DefName,DefPos,static_svg_not_inlined), |
2739 | | ajoin(['Copying ',DefName,' *after* SVG file: '],Msg), |
2740 | | add_message(visb_visualiser,Msg,File,DefPos), |
2741 | | format(Stream,'~w~n',[Contents]), |
2742 | | fail |
2743 | | ; true |
2744 | | ), |
2745 | | gen_new_svg_objects(Stream). |
2746 | | copy_svg_file_and_gen_objects(_,_,_) :- |
2747 | | visb_svg_file(File,AFile,_,Pos,_), |
2748 | | File \= '', |
2749 | | add_error(visb_visualiser,'The specified VisB SVG file does not exist:',AFile,Pos), |
2750 | | fail. |
2751 | | copy_svg_file_and_gen_objects(Stream,SingleStateId,static_svg_inlined) :- % copy an empty SVG stub |
2752 | | visb_file_loaded(_,_,_),!, |
2753 | | write_default_svg_contents(Stream,inline_objects(SingleStateId)). |
2754 | | copy_svg_file_and_gen_objects(_,_,static_svg_not_inlined). % no SVG required; we have no items or events: probably just want HTML export of variables,... |
2755 | | |
2756 | | % get_code is faster than get_char or read_line for larger SVG files |
2757 | | copy_stream(StreamIn,StreamOut) :- |
2758 | | get_code(StreamIn, Code), |
2759 | | (Code = -1 -> true |
2760 | | ; put_code(StreamOut,Code), |
2761 | | copy_stream(StreamIn,StreamOut) |
2762 | | ). |
2763 | | |
2764 | | % TODO: precompile and always assert as visb_special_definition: |
2765 | | get_visb_contents_def(Contents,DefName,DefPos,InlineObjects) :- |
2766 | ? | get_and_eval_special_definition('VISB_SVG_CONTENTS',DefName,visb_contents,DefPos,ResValue,InlineObjects), |
2767 | | b_value_to_string(ResValue,Contents). |
2768 | | get_visb_contents_def(Contents,default_svg_contents,unknown,_InlineObjects) :- |
2769 | | % default content, for VISB_CLICK_META_INFOS'jsVars |
2770 | | Contents = '<script>let visb_vars = {};</script>'. |
2771 | | |
2772 | | % get a definition either from B DEFINITIONS section, or if not present from the VisB JSON special definition list |
2773 | | get_and_eval_special_definition(Prefix,DefName,JSONBackup,DefPos,ResValue,InlineObjects) :- |
2774 | | (b_sorted_b_definition_prefixed(expression,Prefix,DefName,DefPos), |
2775 | ? | b_get_typed_definition(DefName,[variables_and_additional_defs],TBody) |
2776 | | ; |
2777 | | visb_special_definition(JSONBackup,DefName,_Type,TBody,_Class,DefPos) |
2778 | | ), |
2779 | | % TODO: warn if we use static SVG |
2780 | ? | get_typed_static_definition_with_constants_state(DefName,TBody, |
2781 | | Body,DefPos,ConstantsState,InlineObjects,no_separation), |
2782 | | evaluate_visb_formula(Body,DefName,'',ConstantsState,ResValue,DefPos). |
2783 | | |
2784 | | write_default_svg_contents(Stream,InlineObjects) :- |
2785 | | (visb_empty_svg_box_height_width(H,W,ViewBox) -> true ; H=400, W=400, ViewBox=''), |
2786 | | format(Stream,'<svg xmlns=\"http://www.w3.org/2000/svg\"~n',[]), |
2787 | | (ViewBox='' |
2788 | | -> format(Stream,' width="~w" height="~w" viewBox="0 0 ~w ~w" >~n',[W,H,W,H]) |
2789 | | ; format(Stream,' width="~w" height="~w" viewBox="~w" >~n',[W,H,ViewBox]) |
2790 | | ), |
2791 | ? | ( get_visb_contents_def(Contents,_,_,InlineObjects), |
2792 | | format(Stream,'~w~n',[Contents]), |
2793 | | fail |
2794 | | ; true), |
2795 | | (InlineObjects=inline_objects(StateID) -> inline_new_svg_objects(Stream,StateID) ; true), |
2796 | | format(Stream,'</svg>~n',[]). |
2797 | | |
2798 | | % get SVG file contents in case no SVG file is provided by user |
2799 | | get_visb_default_svg_file_contents(Codes) :- |
2800 | | with_open_stream_to_codes( |
2801 | | write_default_svg_contents(Stream,inline_objects(root)), |
2802 | | % allow inlining for groups and title children in ProB2-UI |
2803 | | Stream, |
2804 | | Codes, []). |
2805 | | |
2806 | | % ----------------- |
2807 | | |
2808 | | % create a script to add all additional SVG objects |
2809 | | gen_new_svg_objects(_) :- \+ visb_svg_object(_,_,_,_,_),!. |
2810 | | gen_new_svg_objects(Stream) :- |
2811 | | format(Stream, '<script>~n',[]), |
2812 | | format(Stream, ' const svg = document.querySelector("svg");~n',[]), |
2813 | | format(Stream, ' const svgns = "http://www.w3.org/2000/svg";~n',[]), |
2814 | | (gen_new_svg_object(Stream,svg_root,_),fail ; true), |
2815 | | format(Stream, '</script>~n',[]). |
2816 | | |
2817 | | % generate JS script to create an individual new object |
2818 | | gen_new_svg_object(Stream,ParentID,SVGID) :- |
2819 | | visb_svg_object(SVGID,SVG_Class,AttrList,_,_Pos), |
2820 | | (ParentID=svg_root |
2821 | | -> \+ visb_svg_child(SVGID,_) % only generate root svg objects that have no parents |
2822 | | ; true), |
2823 | | add_svg_id_prefix(SVGID,SVGID2), |
2824 | | format(Stream,' if(document.getElementById("~w") == null) {~n',[SVGID2]), |
2825 | | format(Stream,' var new___obj = document.createElementNS(svgns,"~w");~n',[SVG_Class]), |
2826 | | format(Stream,' new___obj.setAttribute("~w","~w");~n',[id,SVGID2]), |
2827 | | maplist(gen_new_svg_attr(Stream,SVGID2),AttrList), |
2828 | | (ParentID \= svg_root |
2829 | | -> format(Stream,' document.getElementById("~w").appendChild(new___obj);~n',[ParentID]) |
2830 | | ; format(Stream,' svg.appendChild(new___obj);~n',[]) |
2831 | | ), |
2832 | | format(Stream,' }~n',[]), |
2833 | | (visb_svg_parent(SVGID,ChildID), % we can now generate the children |
2834 | | gen_new_svg_object(Stream,SVGID,ChildID), |
2835 | | fail |
2836 | | ; true). |
2837 | | |
2838 | | gen_new_svg_attr(Stream,_SVGID,svg_attribute(text,Val)) :- !, |
2839 | | format(Stream,' new___obj.textContent = "~w";~n',[Val]). |
2840 | | gen_new_svg_attr(Stream,_SVGID,svg_attribute(Attr,Val)) :- |
2841 | | format(Stream,' new___obj.setAttribute("~w","~w");~n',[Attr,Val]). |
2842 | | |
2843 | | % instead of creating a script to create new SVG objects, |
2844 | | % create an inlined textual XML representation of the objects |
2845 | | % this can be used to obtain a static SVG file which can be modified in an editor |
2846 | | % and then later used instead of the VISB_SVG_OBJECTS definitions |
2847 | | inline_new_svg_objects(Stream,StateId) :- |
2848 | | get_dynamic_svgid_attributes_for_state(StateId,DynUpdateList), % compute updates only once |
2849 | ? | visb_svg_object(SVGID,_,_,_,_), % lookup static SVG object |
2850 | | \+ visb_svg_child(SVGID,_), % children will be created in the scope of their parent |
2851 | | inline_new_svg_object(Stream,StateId,DynUpdateList,0,unknown,SVGID), |
2852 | | fail. |
2853 | | inline_new_svg_objects(_,_). |
2854 | | |
2855 | | inline_new_svg_object(Stream,StateId,DynUpdateList,IndentLevel,ParentPos,SVGID) :- |
2856 | | (visb_svg_object(SVGID,SVG_Class,StaticAttrList,_,Pos) -> true % lookup static SVG object |
2857 | | ; add_warning(visb_visualiser,'Unknown SVG child object: ',SVGID,ParentPos),fail |
2858 | | ), |
2859 | | add_svg_id_prefix(SVGID,SVGID2), % for Jupyter |
2860 | | indent_ws(Stream,IndentLevel), |
2861 | | format(Stream,' <~w id="~w"',[SVG_Class,SVGID2]), |
2862 | | (member(svgid_updates(SVGID,DynAttrList),DynUpdateList) % TODO: use avl_fetch |
2863 | | -> override_attributes(StaticAttrList,DynAttrList,AttrList) |
2864 | | ; AttrList=StaticAttrList), |
2865 | | maplist(format_new_svg_attr(Stream,SVGID,Pos,TextContent),AttrList), |
2866 | | (TextContent='' |
2867 | | -> EscapedTextContent="" % set Text variable to empty if unbound |
2868 | | ; do_not_escape_text_for_class(SVG_Class) -> atom_codes(TextContent,EscapedTextContent) |
2869 | | ; atom_codes(TextContent,TCC), html_escape_codes(TCC,EscapedTextContent)), |
2870 | | format(Stream,'>~s',[EscapedTextContent]), % Note: this text is not inside quotes, we need HTML escape |
2871 | | IL1 is IndentLevel+1, |
2872 | ? | ( visb_svg_parent(SVGID,Child), |
2873 | | nl(Stream), |
2874 | | inline_new_svg_object(Stream,StateId,DynUpdateList,IL1,Pos,Child), |
2875 | | fail |
2876 | | ; true), |
2877 | | format(Stream,'</~w>~n',[SVG_Class]), % end marker |
2878 | | fail. |
2879 | | inline_new_svg_object(_,_,_,_,_,_). |
2880 | | |
2881 | | % for foreignObjects the text may contain HTML tags which should not be escaped: |
2882 | | do_not_escape_text_for_class(foreignObject). |
2883 | | do_not_escape_text_for_class(script). % otherwise " quotes will be escaped to " |
2884 | | |
2885 | | indent_ws(_,X) :- X<1,!. |
2886 | | indent_ws(Stream,X) :- write(Stream,' '), X1 is X-1, indent_ws(Stream,X1). |
2887 | | |
2888 | | % combinde svg_attribute/2 terms from two sorted lists, giving precedence to second list |
2889 | | override_attributes([],L,R) :- !, R=L. |
2890 | | override_attributes(L,[],R) :- !, R=L. |
2891 | | override_attributes([svg_attribute(Attr1,Val1)|T1],[svg_attribute(Attr2,Val2)|T2],[svg_attribute(Attr3,Val3)|T3]) :- |
2892 | | (Attr1=Attr2 |
2893 | | -> Attr3=Attr1, Val3=Val2, % dynamic value Val2 takes precedence |
2894 | | override_attributes(T1,T2,T3) |
2895 | | ; Attr1 @< Attr2 -> Attr3=Attr1, Val3=Val1, override_attributes(T1,[svg_attribute(Attr2,Val2)|T2],T3) |
2896 | | ; Attr3=Attr2, Val3=Val2, override_attributes([svg_attribute(Attr1,Val1)|T1],T2,T3) |
2897 | | ). |
2898 | | |
2899 | | % get dynamic svg_attribute/2 list for a given state and SVG ID |
2900 | | get_dynamic_svgid_attributes_for_state(root,List) :- !, List=[]. |
2901 | | get_dynamic_svgid_attributes_for_state(StateId,UpdateList) :- |
2902 | | get_visb_attributes_for_state(StateId,List), |
2903 | | sort(List,SList), |
2904 | | group_set_attr(SList,'$$UNKNOWN$$',_,UpdateList). |
2905 | | |
2906 | | group_set_attr([],_,[],[]). |
2907 | | group_set_attr([set_attr(SvgID,Attr,Val)|T],SvgID,[svg_attribute(Attr,Val)|T1],T2) :- !, |
2908 | | group_set_attr(T,SvgID,T1,T2). |
2909 | | group_set_attr([set_attr(SvgID,Attr,Val)|T],_OldID,[],[svgid_updates(SvgID,L)|T2]) :- % a new SVGId is encountered |
2910 | | group_set_attr([set_attr(SvgID,Attr,Val)|T],SvgID,L,T2). |
2911 | | |
2912 | | % print svg attribute and extract text attribute |
2913 | | format_new_svg_attr(Stream,SVGID,Pos,TextContent,svg_attribute(Attr,Val)) :- % TODO: text content |
2914 | | (Attr=text |
2915 | | -> (TextContent=Val -> true % TextContent is inially a variable and can be unified once |
2916 | | ; add_warning(inline_new_svg_objects,'Multiple text attributes for: ',SVGID,Pos), |
2917 | | add_debug_message(inline_new_svg_objects,' * Using text 1: ',TextContent), |
2918 | | add_debug_message(inline_new_svg_objects,' * Ignoring text 2: ',Val) |
2919 | | ) |
2920 | | ; number(Val) -> |
2921 | | format(Stream,' ~w="~w"',[Attr,Val]) |
2922 | | ; escape_value_to_codes_for_js(Val,ECodes) -> |
2923 | | format(Stream,' ~w="~s"',[Attr,ECodes]) |
2924 | | ; compound(Val) -> |
2925 | | ajoin(['Cannot escape ',Attr,' *compound* value for ', SVGID,': '],Msg), |
2926 | | add_error(visb_visualiser,Msg,Val,Pos), |
2927 | | format(Stream,' ~w="~w"',[Attr,Val]) |
2928 | | ; ajoin(['Cannot escape ',Attr,' value for ', SVGID,': '],Msg), |
2929 | | add_error(visb_visualiser,Msg,Val,Pos), |
2930 | | format(Stream,' ~w="~w"',[Attr,Val]) |
2931 | | ). |
2932 | | |
2933 | | |
2934 | | :- dynamic id_namespace_prefix/1. |
2935 | | % prefix that can be useful for Jupyter notebooks so that for each state we have a different namespace |
2936 | | % can also be useful for exporting a trace into a single HTML |
2937 | | % TODO: does not work with JSON and SVG files |
2938 | | |
2939 | | :- use_module(probsrc(gensym),[gensym/2]). |
2940 | | set_id_namespace_prefix_for_states(_,Options) :- |
2941 | | member(id_namespace_prefix(Pre),Options),!, |
2942 | | (Pre = auto |
2943 | | -> gensym('visb',ID), % for Jupyter this relies on the fact the gensym is *not* reset when loading another spec |
2944 | | atom_concat(ID,'.',Prefix) |
2945 | | ; Prefix=Pre |
2946 | | ), set_id_namespace_prefix(Prefix). |
2947 | | set_id_namespace_prefix_for_states(_,_). |
2948 | | |
2949 | | set_id_namespace_prefix(Prefix) :- clear_id_namespace_prefix, |
2950 | | assert(id_namespace_prefix(Prefix)). |
2951 | | clear_id_namespace_prefix :- retractall(id_namespace_prefix(_)). |
2952 | | |
2953 | | % add a namespace prefix to an SVG ID |
2954 | | add_svg_id_prefix(SvgID,Res) :- id_namespace_prefix(Prefix),!, |
2955 | | % option where we prefix all Ids with a namespace for Jupyter to combine multiple SVGs in single HTML page |
2956 | | atom_concat(Prefix,SvgID,Res). |
2957 | | add_svg_id_prefix(SvgID,SvgID). |
2958 | | |
2959 | | % only add for known objects |
2960 | | opt_add_svg_id_prefix(SvgID,Res) :- id_namespace_prefix(Prefix), |
2961 | | visb_svg_object(SvgID,_,_,_,_),!, % only add prefix for SVG objects we know about (that were created by VisB) |
2962 | | % option where we prefix all Ids with a namespace for Jupyter to combine multiple SVGs in single HTML page |
2963 | | atom_concat(Prefix,SvgID,Res). |
2964 | | opt_add_svg_id_prefix(SvgID,SvgID). |
2965 | | |
2966 | | % ----------------- |
2967 | | |
2968 | | :- dynamic js_generated_function/1. |
2969 | | :- dynamic last_attribute_values/3. |
2970 | | |
2971 | | % define a visualise JS function to set the attributes for the given StateId |
2972 | | gen_visb_visualise_function(Stream,Options,Len,StateIds,Obj) :- |
2973 | | get_state_and_action(Obj,StateId,ActionStr,DescStr), |
2974 | ? | nth1(Nr,StateIds,Obj), |
2975 | | \+ js_generated_function(Nr), !, |
2976 | | assertz(js_generated_function(Nr)), |
2977 | | (Nr > 1 -> |
2978 | | PrevNr is Nr-1, nth1(PrevNr,StateIds,PrevObj), get_state_and_action(PrevObj,PrevStateId,_,_) |
2979 | | ; PrevStateId = -1), |
2980 | | visb_visualise_function_aux(Stream,Options,Len,StateId,PrevStateId,Nr,ActionStr,DescStr), |
2981 | | (Nr == Len -> |
2982 | | retractall(last_attribute_values(_,_,_)), |
2983 | | format(Stream,' ]~n',[]) |
2984 | | ; true). |
2985 | | gen_visb_visualise_function(_,_,_,_,_). |
2986 | | |
2987 | | :- use_module(probsrc(tools),[string_escape/2]). |
2988 | | visb_visualise_function_aux(Stream,_,Len,StateId,_,Nr,ActionStr,DescStr) :- |
2989 | | format(Stream,' [~n',[]), |
2990 | | (Len>1 -> format(Stream,' {id: "trace_meter", attr: "value", val: "~w"},~n',[Nr]) ; true), |
2991 | | (escape_value_to_codes_for_js(ActionStr,EAS), escape_value_to_codes_for_js(DescStr,EDS) -> |
2992 | | % was only string_escape before; however, this turns e.g. |-> into ↦ which we don't want (we are in JS part here) |
2993 | | format(Stream,' {id: "visb_debug_messages", attr: "text", val: "Step ~w/~w, State ID: ~w, Event: ~s ~s"},~n',[Nr,Len,StateId,EAS,EDS]) |
2994 | | ; string_escape(ActionStr,SEAS), string_escape(DescStr,SEDS), % fallback |
2995 | | format(Stream,' {id: "visb_debug_messages", attr: "text", val: "Step ~w/~w, State ID: ~w, Event: ~w ~w"},~n',[Nr,Len,StateId,SEAS,SEDS]) |
2996 | | ), |
2997 | ? | get_change_attribute_for_state(StateId,SvgID,SvgAttribute,Value), |
2998 | | \+ last_attribute_values(SvgID,SvgAttribute,Value), |
2999 | | retractall(last_attribute_values(SvgID,SvgAttribute,_)), |
3000 | | assertz(last_attribute_values(SvgID,SvgAttribute,Value)), |
3001 | | opt_add_svg_id_prefix(SvgID,SvgID2), |
3002 | | (escape_value_to_codes_for_js(Value,ECodes) |
3003 | | -> format(Stream,' {id: "~w", attr: "~w", val: "~s"},~n',[SvgID2,SvgAttribute,ECodes]) |
3004 | | ; format(Stream,' {id: "~w", attr: "~w", val: "~w"},~n',[SvgID2,SvgAttribute,Value]) |
3005 | | ), |
3006 | | fail. |
3007 | | visb_visualise_function_aux(Stream,Options,Len,StateId,PrevStateId,_,_,_) :- |
3008 | | member(show_variables(VarList),Options), |
3009 | | |
3010 | | visited_expression(StateId,State), |
3011 | | (visited_expression(PrevStateId,PrevState) -> true ; PrevState=root), |
3012 | | |
3013 | | show_var_in_visb(VarList,ID), |
3014 | ? | get_state_value_change(StateId,State,ID,Options,ResValCodes), |
3015 | | |
3016 | | % current value: |
3017 | | ajoin(['bVar_',ID],SvgID), |
3018 | | change_svg_attribute_differences_aux(Stream,SvgID,'text',ResValCodes), |
3019 | | |
3020 | | Len > 1, % don't add previous value and change markers for state-only HTML |
3021 | | (state_corresponds_to_fully_setup_b_machine(PrevState,_), % don't show prev values before initialisation |
3022 | ? | get_state_value_change(PrevStateId,PrevState,ID,Options,PrevResValCodes) |
3023 | | -> true |
3024 | | ; PrevResValCodes = "?"), |
3025 | | |
3026 | | % mark row if value has changed in the last step |
3027 | | ajoin(['row_bVar_',ID],SvgRowID), |
3028 | | (ResValCodes = PrevResValCodes -> RowColor = white; RowColor = '#fffacd'), |
3029 | | change_svg_attribute_differences_aux(Stream,SvgRowID,'bgcolor',RowColor), |
3030 | | |
3031 | | % previous value: |
3032 | | ajoin(['bVarPrev_',ID],SvgPrevID), |
3033 | | change_svg_attribute_differences_aux(Stream,SvgPrevID,'text',PrevResValCodes), |
3034 | | |
3035 | | fail. |
3036 | | visb_visualise_function_aux(Stream,Options,_,StateId,_,_,_,_) :- |
3037 | | member(show_events(OpList),Options), |
3038 | | get_state_value_enabled_operation_status(StateId,OpID,Enabled,ResValCodes,TransStr), |
3039 | | show_var_in_visb(OpList,OpID), |
3040 | | ajoin(['bOperation_',OpID],SvgID), |
3041 | | \+ last_attribute_values(SvgID,'text',ResValCodes), |
3042 | | retractall(last_attribute_values(SvgID,'text',_)), |
3043 | | assertz(last_attribute_values(SvgID,'text',ResValCodes)), |
3044 | | format(Stream,' {id: "~w", attr: "text", val: "~s"},~n',[SvgID,ResValCodes]), |
3045 | | (Enabled=true -> BGCol=white ; BGCol='#f1f1f1'), |
3046 | | format(Stream,' {id: "row_~w", attr: "bgcolor", val: "~s"},~n',[SvgID,BGCol]), |
3047 | | escape_value_to_codes_for_js(TransStr,ETS), |
3048 | | format(Stream,' {id: "name_~w", attr: "text", val: "~s"},~n',[SvgID,ETS]), |
3049 | | % TO DO: highlight next event in trace, but then function needs one more parameter |
3050 | | fail. |
3051 | | visb_visualise_function_aux(Stream,Options,Len,_,_,Nr,_,_) :- |
3052 | | (Len>1, member(show_sequence_chart,Options) |
3053 | | -> format(Stream,' {id: "seq_chart_~w", attr: "style", val: "display:block"},~n',[Nr]), |
3054 | | (Nr>1 |
3055 | | -> PNr is Nr-1, format(Stream,' {id: "seq_chart_~w", attr: "style", val: "display:none"},~n',[PNr]) |
3056 | | ; gen_seq_charts_setup(Stream,Len))), % all sequence charts except the first should be invisible |
3057 | | fail. |
3058 | | visb_visualise_function_aux(Stream,_,Len,_,_,Nr,_,_) :- |
3059 | | Nr == Len -> |
3060 | | format(Stream,' ]~n',[]) |
3061 | | ; format(Stream,' ],~n',[]). |
3062 | | |
3063 | | gen_seq_charts_setup(_,Len) :- Len<2, !. |
3064 | | gen_seq_charts_setup(Stream,Len) :- |
3065 | | format(Stream,' {id: "seq_chart_~w", attr: "style", val: "display:none"},~n',[Len]), |
3066 | | NLen is Len-1, |
3067 | | gen_seq_charts_setup(Stream,NLen). |
3068 | | |
3069 | | escape_value_to_codes_for_js(Atom,ECodes) :- atom(Atom), |
3070 | | atom_codes(Atom,Codes), b_string_escape_codes(Codes,ECodes). |
3071 | | |
3072 | | change_svg_attribute_differences_aux(Stream,ID,Attr,ValueCodes) :- |
3073 | | (last_attribute_values(ID,Attr,ValueCodes) |
3074 | | -> true |
3075 | | ; retractall(last_attribute_values(ID,Attr,_)), |
3076 | | assertz(last_attribute_values(ID,Attr,ValueCodes)), |
3077 | | format(Stream,' {id: "~w", attr: "~w", val: "~s"},~n',[ID,Attr,ValueCodes]) |
3078 | | ). |
3079 | | |
3080 | | |
3081 | | |
3082 | | % generate JS script to register hovers |
3083 | ? | gen_registerHovers_scipt(Stream,Options) :- \+ visb_has_hovers(_), |
3084 | | nonmember(debugging_hovers,Options), |
3085 | | !, % no hover exists |
3086 | | format(Stream,' <script> function registerHovers() {} </script>~n',[]). |
3087 | | gen_registerHovers_scipt(Stream,Options) :- |
3088 | | (member(debugging_hovers,Options) -> GenDebug=true ; GenDebug=false), % gen debugging hovers |
3089 | | % Jquery is no longer required: |
3090 | | %format(Stream,' <script src="https://ajax.googleapis.com/ajax/libs/jquery/3.6.0/jquery.min.js"></script>~n',[]), |
3091 | | format(Stream,' <script>~n',[]), |
3092 | | format(Stream,' function registerHovers() {~n',[]), |
3093 | | format(Stream,' var obj;~n',[]), |
3094 | ? | visb_has_hovers(SVGID), % only generate hover function if necessary; TODO: examine other IDs for GenDebug |
3095 | | opt_add_svg_id_prefix(SVGID,SVGID2), |
3096 | | format(Stream,' obj = document.getElementById("~w");~n',[SVGID2]), |
3097 | | format(Stream,' obj.onmouseover = function(ev){~n',[]), |
3098 | ? | (visb_hover(SVGID,ID,Attr,EnterVal,_,_), |
3099 | | opt_add_svg_id_prefix(ID,ID2), |
3100 | | (GenDebug=false -> true |
3101 | | ; format(Stream,' setAttr("~w","~w","SVG ID: ~w")~n',[visb_debug_messages,text,SVGID2])), |
3102 | | format(Stream,' setAttr("~w","~w","~w")~n',[ID2,Attr,EnterVal]), fail ; |
3103 | | format(Stream,' };~n',[]) |
3104 | | ), |
3105 | | format(Stream,' obj.onmouseout = function(){~n',[]), |
3106 | ? | (visb_hover(SVGID,ID,Attr,_,LeaveVal,_), |
3107 | | opt_add_svg_id_prefix(ID,ID2), |
3108 | | (GenDebug=false -> true |
3109 | | ; format(Stream,' setAttr("~w","~w","~w")~n',[visb_debug_messages,text,'...']) |
3110 | | ), |
3111 | | format(Stream,' setAttr("~w","~w","~w")~n',[ID2,Attr,LeaveVal]), fail ; |
3112 | | format(Stream,' };~n',[]) |
3113 | | ), |
3114 | | fail. |
3115 | | gen_registerHovers_scipt(Stream,_) :- |
3116 | | format(Stream,' }~n </script>~n',[]). |
3117 | | |
3118 | | |
3119 | | % ---------------------------------- |
3120 | | |
3121 | | :- use_module(probsrc(translate),[set_unicode_mode/0, unset_unicode_mode/0]). |
3122 | | :- use_module(probsrc(state_space), [get_action_trace_with_limit/2, get_state_id_trace/1]). |
3123 | | |
3124 | | generate_visb_html_for_history_with_source(File) :- |
3125 | | generate_visb_html_for_history(File, |
3126 | | [show_constants(all),show_sets(all),show_variables(all),show_events(all),show_invariants,show_source]). |
3127 | | generate_visb_html_for_history_with_vars(File) :- |
3128 | | generate_visb_html_for_history(File,[show_constants(all),show_sets(all),show_variables(all),show_events(all)]). |
3129 | | generate_visb_html_for_history(File) :- |
3130 | | generate_visb_html_for_history(File,[]). |
3131 | | generate_visb_html_for_history(File,Options) :- |
3132 | | start_ms_timer(Timer), |
3133 | | get_state_id_trace(T), |
3134 | | T = [root|StateIds], |
3135 | | set_unicode_mode, |
3136 | | call_cleanup(get_action_trace_with_limit(120,Actions), % TODO: also get description of JSON traces |
3137 | | unset_unicode_mode), |
3138 | | reverse(Actions,FActions), |
3139 | | combine_state_and_actions(StateIds,[root|StateIds],FActions,List), |
3140 | | generate_visb_html(List,File,Options), |
3141 | | stop_ms_walltimer_with_msg(Timer,'exporting history to VisB HTML file: '). |
3142 | | |
3143 | | :- use_module(probsrc(specfile),[get_operation_description_for_transition/4]). |
3144 | | combine_state_and_actions([],_,[],[]). |
3145 | | combine_state_and_actions([StateId|TS],[PrevId|TP],[action(ActionStr,ATerm)|TA], |
3146 | | [change_to_state_via_action(StateId,ActionStr,Desc)|TRes]) :- |
3147 | | (get_operation_description_for_transition(PrevId,ATerm,StateId,D) -> Desc=D ; Desc=''), |
3148 | | combine_state_and_actions(TS,TP,TA,TRes). |
3149 | | |
3150 | | generate_visb_html_for_current_state(File) :- |
3151 | | generate_visb_html_for_current_state(File,[show_variables(all)]). |
3152 | | generate_visb_html_for_current_state(File,Options) :- |
3153 | | start_ms_timer(Timer), |
3154 | | current_state_id(ID), |
3155 | | generate_visb_html([ID],File,Options), |
3156 | | stop_ms_walltimer_with_msg(Timer,'exporting current state to VisB HTML file: '). |
3157 | | generate_visb_html_codes_for_states(StateIds,Options,Codes) :- |
3158 | | generate_visb_html_to_codes(StateIds,Options,Codes). % write to codes list |
3159 | | |
3160 | | % ------------------------------ |
3161 | | |
3162 | | :- use_module(probsrc(specfile),[b_or_z_mode/0]). |
3163 | | :- use_module(probsrc(bmachine), [b_get_machine_variables/1, b_get_machine_constants/1, b_top_level_operation/1]). |
3164 | | :- use_module(probsrc(bsyntaxtree), [get_texpr_id/2]). |
3165 | | :- use_module(extrasrc(bvisual2), [bv_top_level_set/2]). |
3166 | | :- use_module(probsrc(specfile),[get_specification_description/2]). |
3167 | | :- use_module(probsrc(tools_strings), [atom_tail_to_lower_case/2]). |
3168 | | |
3169 | | show_typed_var_in_visb(all,_) :- !. |
3170 | | show_typed_var_in_visb(VarList,b(identifier(ID),_,_)) :- !, show_var_in_visb(VarList,ID). |
3171 | | show_var_in_visb(VarList,ID ) :- (VarList=all -> true ; member(ID,VarList) -> true). |
3172 | | |
3173 | | % generate a table for the state (we could use bvisual2) |
3174 | | gen_state_table(Stream,Options,StateIds) :- |
3175 | | b_or_z_mode, |
3176 | | member(show_variables(VarList),Options), |
3177 | | b_get_machine_variables(TypedVars), |
3178 | | % is this useful if Len > 1, but StateIds are not from a trace? (see also below for formulas) |
3179 | | (length(StateIds,Len), Len > 1 -> NOptions = [show_prev_value|Options] ; NOptions = Options), |
3180 | | gen_state_table_aux(Stream,NOptions,'Variables',TypedVars,VarList,[],'Value','bVar_'),fail. |
3181 | | gen_state_table(Stream,Options,StateIds) :- |
3182 | | b_or_z_mode, |
3183 | | member(show_variables(VarList),Options), |
3184 | | b_get_machine_expressions(AExprs,Options), AExprs \= [], |
3185 | | (length(StateIds,Len), Len > 1 -> NOptions = [show_prev_value|Options] ; NOptions = Options), |
3186 | | gen_state_table_aux(Stream,NOptions,'Formulas',AExprs,VarList,[],'Value','bVar_'),fail. |
3187 | | gen_state_table(Stream,Options,StateIds) :- |
3188 | | b_or_z_mode, |
3189 | ? | member(show_constants(IDList),Options), |
3190 | | b_get_machine_constants(TypedVars), |
3191 | | last(StateIds,Last), % we assume there is only one constant valuation in the trace; TO DO: generalise |
3192 | | get_state_and_action(Last,LastId,_,_), |
3193 | | visited_expression(LastId,BState), |
3194 | | expand_to_constants_and_variables(BState,ConstState,_), |
3195 | | gen_state_table_aux(Stream,Options,'Constants',TypedVars,IDList,ConstState,'Value','bConstant_'),fail. |
3196 | | gen_state_table(Stream,Options,_) :- |
3197 | | b_or_z_mode, |
3198 | ? | member(show_sets(IDList),Options), |
3199 | | findall(TSet,bv_top_level_set(TSet,_),TypedVars), |
3200 | | findall(bind(Set,Val),(bv_top_level_set(TSet,Val),get_texpr_id(TSet,Set)),BState), |
3201 | | gen_state_table_aux(Stream,Options,'Sets',TypedVars,IDList,BState,'Value','bSet_'),fail. |
3202 | | % TO DO: maybe show also top-level guards specfile_possible_trans_name or get_top_level_guard |
3203 | | gen_state_table(Stream,Options,_StateIds) :- |
3204 | | b_or_z_mode, |
3205 | | member(show_events(IDList),Options), |
3206 | | get_specification_description(operations,SN), |
3207 | | atom_tail_to_lower_case(SN,SectionName), |
3208 | | findall(b(identifier(OpName),subst,[]),b_top_level_operation(OpName),TypedVars), |
3209 | | % TODO: op(Params,Results) instead of subst |
3210 | | gen_state_table_aux(Stream,Options,SectionName,TypedVars,IDList,[],'Enabled','bOperation_'),fail. |
3211 | | gen_state_table(_Stream,_,_). |
3212 | | |
3213 | | |
3214 | | gen_source_code_section(Stream,Options) :- |
3215 | | member(show_source,Options), % we could also include original sources, rather than just internal rep. |
3216 | | !, |
3217 | | Section = 'Source', |
3218 | | format(Stream,' <button type="button" class="collapsible collapsible-style" title="Inspect source code of internal representation of ProB of model">~w</button>~n',[Section]), |
3219 | | format(Stream,'<div class="coll-content-hid">~n',[]), |
3220 | | get_internal_representation(PP), |
3221 | | format(Stream,'<pre>~s</pre>~n',[PP]), |
3222 | | format(Stream,'</div>~n',[]). |
3223 | | gen_source_code_section(_Stream,_). |
3224 | | |
3225 | | |
3226 | | :- use_module(probsrc(bsyntaxtree),[get_texpr_description/2, get_texpr_type/2]). |
3227 | | % creates a HTML table with header name Section and including one row per ID in TypedVars; |
3228 | | % id of value for ID is prefixed with IDPrefix |
3229 | | % VarListToShow is either all or a list of ids |
3230 | | gen_state_table_aux(Stream,Options,Section,TypedVars,VarListToShow,BState,ValueStr,IDPrefix) :- |
3231 | | include(show_typed_var_in_visb(VarListToShow),TypedVars,SVars), % check which ids should be shown |
3232 | | length(SVars,SLen), SLen>0, |
3233 | | length(TypedVars,Len), |
3234 | | (SLen=Len |
3235 | | -> format(Stream,' <button type="button" class="collapsible collapsible-style">~w (~w)</button>~n',[Section,SLen]) |
3236 | | ; format(Stream,' <button type="button" class="collapsible collapsible-style">~w (~w/~w)</button>~n', |
3237 | | [Section,SLen,Len]) |
3238 | | ), |
3239 | | format(Stream,'<div class="coll-content-hid">~n',[]), |
3240 | ? | (member(show_prev_value,Options) % add extra column for previous value of variables (and animation expressions) |
3241 | | -> format(Stream,' <table> <tr> <th>Nr</th> <th>Name</th> <th>Value</th> <th>Previous Value</th> </tr>~n',[]) |
3242 | | ; format(Stream,' <table> <tr> <th>Nr</th> <th>Name</th> <th>~w</th> </tr>~n',[ValueStr])), |
3243 | ? | ( nth1(Nr,SVars,IDorExprToShow), |
3244 | | get_state_table_name_and_expr(IDorExprToShow,ID,LongID,TExpr), |
3245 | ? | (get_state_value_codes_for_id(BState,ID,Options,_,ValCodes) |
3246 | | -> html_escape_codes(ValCodes,EVC) % Value provided in BState; may be overriden in trace export |
3247 | | ; EVC = "?"), |
3248 | | get_table_hover_message_codes(ID,TExpr,HoverMsgC), |
3249 | ? | (member(show_prev_value,Options) % add previous value of variables (and animation expressions) |
3250 | | -> % for variables the values are added later in JS |
3251 | | % do we want to show the previous value in the state only HTML? |
3252 | | format(Stream,'~n <tr id="row_~w~w" title="~s"> <td>~w</td> <td id="name_~w~w">~w</td> <td id="~w~w">?</td> <td id="bVarPrev_~w">?</td> </tr>~n', |
3253 | | [IDPrefix,ID, HoverMsgC, Nr, IDPrefix,ID,LongID, IDPrefix,ID, ID ]) |
3254 | | ; |
3255 | | format(Stream,'~n <tr id="row_~w~w" title="~s"> <td>~w</td> <td id="name_~w~w">~w</td> <td id="~w~w">~s</td> </tr>~n', |
3256 | | [IDPrefix,ID, HoverMsgC, Nr, IDPrefix,ID,LongID, IDPrefix,ID,EVC])), |
3257 | | fail |
3258 | | ; |
3259 | | format(Stream,' </table>~n </div>~n',[]) |
3260 | | ). |
3261 | | |
3262 | | %get_state_table_name_and_expr(bexpr(Kind,TExpr),Name,LongName,Expr) :- !, % we have special expression to show |
3263 | | % Name=Kind,LongName=Kind,Expr=TExpr. |
3264 | | get_state_table_name_and_expr(bexpr(Kind,TExpr),ID,LongName,Expr) :- !, % we have special expression to show |
3265 | | ID=Kind, % ID for SVG updates, ... |
3266 | | translate_bexpression_with_limit(TExpr,200,TS), |
3267 | | ajoin([Kind,' == ',TS],LongName), |
3268 | | Expr=TExpr. |
3269 | | get_state_table_name_and_expr(TID,ID,ID,TID) :- get_texpr_id(TID,ID). % normal case: variable name |
3270 | | |
3271 | | |
3272 | | :- use_module(probsrc(bmachine),[b_get_machine_animation_expression/2, b_get_operation_variant/3, b_nth1_invariant/3]). |
3273 | | |
3274 | | visb_machine_animation_expression(variant,AEName,Variant,_) :- |
3275 | | b_get_operation_variant(Name,ConvOrAnt,Variant), |
3276 | | ajoin(['Variant for ',Name, ' (',ConvOrAnt,')'],AEName). |
3277 | | visb_machine_animation_expression(animation_expression,Name,TExpr,_) :- |
3278 | | b_get_machine_animation_expression(Name,TExpr). |
3279 | | visb_machine_animation_expression(invariant,Name,TPred,Options) :- |
3280 | | member(show_invariants,Options), |
3281 | | b_nth1_invariant(Nr,TPred,_), |
3282 | | ajoin(['INVARIANT-',Nr],Name). |
3283 | | % TODO: we should also adapt get_state_value_change to return true when invariant_violated is false for the state |
3284 | | % we could also only include this section when there is an invariant violation in the trace? |
3285 | | |
3286 | | b_get_machine_expressions(List,Options) :- |
3287 | | findall(bexpr(AE_Name,AExpr),visb_machine_animation_expression(_,AE_Name,AExpr,Options),List). |
3288 | | % 'ANIMATION_EXPRESSION' or invariants or variants |
3289 | | |
3290 | | :- use_module(probsrc(bmachine),[b_get_machine_operation_signature/2]). |
3291 | | % get hover message for entries in variables/constants/... rows: |
3292 | | get_table_hover_message_codes(ID,TExpr,EscHoverMsg) :- |
3293 | | get_texpr_type(TExpr,Type), |
3294 | | (Type=subst,b_get_machine_operation_signature(ID,TS) |
3295 | | -> ajoin(['Operation: ',TS],HoverMsg) |
3296 | | ; pretty_type(Type,TS), |
3297 | | (get_texpr_description(TExpr,Desc) |
3298 | | -> ajoin(['Type: ',TS,'\nDesc: ',Desc],HoverMsg) |
3299 | | ; ajoin(['Type: ',TS],HoverMsg) |
3300 | | ) |
3301 | | ), |
3302 | | atom_codes(HoverMsg,HoverCodes), |
3303 | | html_escape_codes(HoverCodes,EscHoverMsg). |
3304 | | |
3305 | | % get the values that should be displayed in the variables table |
3306 | | get_state_value_change(StateId,State,ID,Options,ECodes) :- |
3307 | | extract_variables_from_state(State,VariableBState), |
3308 | ? | ( get_state_value_codes_for_id(VariableBState,ID,Options,Val,ValCodes) % look up variable values |
3309 | | ; visb_machine_animation_expression(_,_,_,Options) -> |
3310 | | state_corresponds_to_fully_setup_b_machine(State,FullState), |
3311 | | get_state_value_codes_for_anim_expr(StateId,FullState,ID,Options,Val,ValCodes) % evaluate animation expressions |
3312 | | ), |
3313 | | escape_if_necessary(Val,ValCodes,ECodes). % change " to \" for JavaScript |
3314 | | % formatsilent('Value for ~w~nunescaped: "~s",~n escaped: "~s"~n',[ID,ValCodes,ECodes]). |
3315 | | |
3316 | | % avoid unnecessary escaping traversals: |
3317 | | escape_if_necessary([],ValCodes,Res) :- !, Res=ValCodes. |
3318 | | escape_if_necessary(int(_),ValCodes,Res) :- !, Res=ValCodes. |
3319 | | escape_if_necessary(pred_true,ValCodes,Res) :- !, Res=ValCodes. |
3320 | | escape_if_necessary(pred_false,ValCodes,Res) :- !, Res=ValCodes. |
3321 | | escape_if_necessary(_,ValCodes,ECodes) :- b_string_escape_codes(ValCodes,ECodes). |
3322 | | |
3323 | | |
3324 | | get_state_value_codes_for_id(BState,ID,Options,Val,ValCodes) :- |
3325 | ? | member(bind(ID,Val),BState), |
3326 | | translate_values_for_state_table(Val,Options,ValCodes). |
3327 | | |
3328 | | % translate a value for display in state table (not yet escaped) |
3329 | | translate_values_for_state_table(Val,Options,ValCodes) :- |
3330 | | (member(limit_for_values(Nr),Options) |
3331 | | -> translate_bvalue_to_codes_with_limit(Val,Nr,ValCodes) |
3332 | | ; get_preference(expand_avl_upto,Max), Max<0 |
3333 | | -> translate_bvalue_to_codes(Val,ValCodes) % unlimited |
3334 | | ; translate_bvalue_to_codes_with_limit(Val,10000,ValCodes) |
3335 | | ). |
3336 | | |
3337 | | :- use_module(probsrc(bsyntaxtree), [safe_create_texpr/3]). |
3338 | | get_state_value_codes_for_anim_expr(StateId,BState,AE_Name,Options,ResValue,ValCodes) :- |
3339 | | visb_machine_animation_expression(Kind,AE_Name,AExpr,Options), |
3340 | | (Kind=invariant |
3341 | | -> ((invariant_not_yet_checked(StateId) ; invariant_violated(StateId)) |
3342 | | -> (safe_create_texpr(convert_bool(AExpr),boolean,TExpr), |
3343 | | evaluate_visb_formula(TExpr,AE_Name,'',BState,ResValue,unknown) |
3344 | | -> translate_pred_val(ResValue,ValCodes) |
3345 | | ; ResValue=pred_unknown, ValCodes = "?" % WD error? |
3346 | | ) |
3347 | | ; ResValue=pred_true, translate_pred_val(pred_true,ValCodes) % no need to evaluate invariant |
3348 | | ) |
3349 | | ; evaluate_visb_formula(AExpr,AE_Name,'',BState,ResValue,unknown), |
3350 | | translate_values_for_state_table(ResValue,Options,ValCodes) |
3351 | | ). |
3352 | | translate_pred_val(pred_true,[8868]). % see translate:unicode_translation(truth,X). |
3353 | | translate_pred_val(pred_false,[8869]). % see translate:unicode_translation(falsity,X). |
3354 | | |
3355 | | :- use_module(probsrc(bmachine),[b_get_machine_operation_max/2]). |
3356 | | :- use_module(probsrc(state_space),[time_out_for_node/3,max_reached_for_node/1]). |
3357 | | :- use_module(probsrc(translate),[translate_event_with_src_and_target_id/5]). |
3358 | | get_state_value_enabled_operation_status(StateId,OpName,Enabled,EnabledValue,TransStr) :- |
3359 | | b_top_level_operation(OpName), |
3360 | | findall(TransID, (transition(StateId,OpTerm,TransID,_NewStateId), |
3361 | | match_operation(OpTerm,OpName)), TransList), |
3362 | | length(TransList,Len), |
3363 | | (Len>0 |
3364 | | -> Enabled=true, |
3365 | | EnabledValue = "\x2705\", % green check mark, TRUE alternatives \x2705\ \x2713\ \x2714\ |
3366 | | (TransList=[TID], transition(StateId,OpTerm,TID,NewStateId), |
3367 | | translate_event_with_src_and_target_id(OpTerm,StateId,NewStateId,200,TransStr) |
3368 | | -> true |
3369 | | ; ajoin([OpName,' (',Len,'\xd7\)'],TransStr) % |
3370 | | ) |
3371 | | ; time_out_for_node(StateId,OpName,TypeOfTimeOut) -> |
3372 | | Enabled=TypeOfTimeOut, |
3373 | | EnabledValue = [8987], % four o'clock symbol |
3374 | | TransStr = OpName |
3375 | | %ajoin(['No transition found due to: ',TypeOfTimeOut],HoverMsg) |
3376 | | ; get_preference(maxNrOfEnablingsPerOperation,0) -> |
3377 | | Enabled=not_computed, |
3378 | | EnabledValue = [10067], % red question mark |
3379 | | TransStr = OpName |
3380 | | %'No transitions were computed because MAX_OPERATIONS = 0' = HoverMsg |
3381 | | ; b_get_machine_operation_max(OpName,0) -> |
3382 | | Enabled=not_computed, |
3383 | | EnabledValue = [10067], % red question mark |
3384 | | TransStr = OpName |
3385 | | %ajoin(['No transitions were computed because MAX_OPERATIONS_',OpName,' = 0'],HoverMsg) |
3386 | | ; Enabled=false, |
3387 | | EnabledValue = [9940], % stop sign, FALSE, alternatives \x10102\ |
3388 | | TransStr = OpName |
3389 | | %ajoin(['Not enabled'],HoverMsg) |
3390 | | ). % TO DO: show whether this is the next step in the trace |
3391 | | |
3392 | | % -------------------------- |
3393 | | |
3394 | | % debugging features to inspect all created SVG objects |
3395 | | tcltk_get_visb_objects(list([Header|AllObjects])) :- |
3396 | | Header = list(['SVG-ID','svg_class','Attribute','Value']), |
3397 | | findall(list([SvgID,SvgClass,Attr,Value]), |
3398 | | (visb_svg_object(SvgID,SvgClass,AttrList,_Desc,_Pos), |
3399 | | (member(svg_attribute(Attr,Value),AttrList) ; |
3400 | | visb_svg_parent(SvgID,Value), Attr=children) |
3401 | | ), AllObjects). |
3402 | | |
3403 | | % debugging features to inspect all created SVG objects |
3404 | | tcltk_get_visb_hovers(list([Header|AllObjects])) :- |
3405 | | Header = list(['SVG-ID','ID','Attribute','EnterValue', 'ExitValue']), |
3406 | | findall(list([SvgID,ID,Attr,EnterVal,ExitVal]), |
3407 | | visb_hover(SvgID,ID,Attr,EnterVal,ExitVal,_Pos), AllObjects). |
3408 | | |
3409 | | % debugging features to inspect items |
3410 | | tcltk_get_visb_items(Res) :- |
3411 | | current_state_id(ID), |
3412 | | tcltk_get_visb_items(ID,Res). |
3413 | | tcltk_get_visb_items(_StateId,Res) :- |
3414 | | \+ visb_file_is_loaded(_),!, |
3415 | | Res = list(['No VisB JSON file loaded']). |
3416 | | tcltk_get_visb_items(StateId,list([Header|AllItems])) :- |
3417 | | Header = list(['SVG-ID','Attribute','Value']), |
3418 | | get_preference(translation_limit_for_table_commands,Limit), |
3419 | | findall(list([SvgID,SvgAttribute,Val]), |
3420 | | get_change_attribute_for_state(StateId,SvgID,SvgAttribute,Val), |
3421 | | Items), |
3422 | | findall(list([DefID,'VisB Definition',DValS]), |
3423 | | (get_expanded_bstate(StateId,ExpandedBState), |
3424 | | reverse(ExpandedBState,RS), |
3425 | | member(bind(DefID,DVal),RS), |
3426 | | visb_definition(DefID,_,_,_,_,_), |
3427 | | translate_bvalue_with_limit(DVal,Limit,DValS)), |
3428 | | AllItems, Items). |
3429 | | |
3430 | | :- use_module(probsrc(translate),[translate_event_with_limit/3]). |
3431 | | tcltk_get_visb_events(Res) :- |
3432 | | current_state_id(ID), |
3433 | | tcltk_get_visb_events(ID,Res). |
3434 | | tcltk_get_visb_events(_StateId,Res) :- |
3435 | | \+ visb_file_is_loaded(_),!, |
3436 | | Res = list(['No VisB JSON file loaded']). |
3437 | | tcltk_get_visb_events(StateId,list([Header|AllItems])) :- |
3438 | | Header = list(['SVG-ID','Event','Target']), |
3439 | | get_preference(translation_limit_for_table_commands,Limit), |
3440 | | findall(list([SvgID,EventStr,NewStateId]), |
3441 | | (perform_visb_click_event(SvgID,[],StateId,_Event,OpTerm,NewStateId,Res), |
3442 | | (Res=[] -> EventStr='disabled' ; translate_event_with_limit(OpTerm,Limit,EventStr)) |
3443 | | ), |
3444 | | AllItems). |
3445 | | % -------------------------- |
3446 | | |
3447 | | % for ProB2-UI |
3448 | | |
3449 | | :- use_module(probsrc(translate),[translate_bexpression_with_limit/3]). |
3450 | | get_visb_items(List) :- |
3451 | | findall(visb_item(SvgID,Attr,TS,Desc,Pos), |
3452 | | (visb_item(SvgID,Attr,TypedExpr,_Used,Desc,Pos,_), |
3453 | | translate_bexpression_with_limit(TypedExpr,1000,TS)), List). |
3454 | | |
3455 | | get_visb_attributes_for_state(StateId,List) :- |
3456 | | % some external functions like ENABLED are evaluated in current state; it might be useful to set_current_state |
3457 | | (visb_file_is_loaded(_) -> true |
3458 | | ; add_warning(visb_visualiser,'No VisB visualisation loaded, cannot get attributes for state: ',StateId)), |
3459 | | findall(set_attr(SvgID,SvgAttribute,Val), |
3460 | | get_change_attribute_for_state(StateId,SvgID,SvgAttribute,Val), |
3461 | | List). |
3462 | | |
3463 | | % for ProB2-UI |
3464 | | get_visb_click_events(List) :- |
3465 | | findall(execute_event(SvgID,Event,Preds), |
3466 | | get_visb_event(SvgID,Event,Preds), List). |
3467 | | get_visb_event(SvgID,Event,Preds) :- visb_event(SvgID,Event,Preds,_,_File,_Pos). |
3468 | | get_visb_event(SvgID,'',[]) :- % add a virtual empty event for SVG Ids with hovers but no events |
3469 | | visb_has_hovers(SvgID), |
3470 | | \+ visb_event(SvgID,_,_,_,_File,_Pos). |
3471 | | |
3472 | | |
3473 | | :- use_module(probsrc(state_space), [extend_trace_by_transition_ids/1]). |
3474 | | % perform a click on a VisB SVG ID in the animator |
3475 | | tcltk_perform_visb_click_event(SvgID) :- current_state_id(StateId), |
3476 | | (perform_visb_click_event(SvgID,[],StateId,TransitionIDs) |
3477 | | -> formatsilent('Clicking on ~w in state ~w resulted in transition id sequence ~w~n',[SvgID,StateId,TransitionIDs]), |
3478 | | extend_trace_by_transition_ids(TransitionIDs) |
3479 | | ; add_error(visb_visualiser,'Cannot perform VisB click on: ',SvgID) |
3480 | | ). |
3481 | | |
3482 | | :- use_module(probsrc(b_state_model_check),[execute_operation_by_predicate_in_state_with_pos/6]). |
3483 | | % computes the effect of clicking on an SvgID in StateId |
3484 | | % it returns either empty list if the visb_event is not feasible or a list of transition ids |
3485 | | % it fails if SvgID has no events associated with it |
3486 | | perform_visb_click_event(SvgID,MetaInfos,StateId,ResTransitionIds) :- |
3487 | | perform_visb_click_event(SvgID,MetaInfos,StateId,_,_,_,ResTransitionIds). |
3488 | | perform_visb_click_event(SvgID,MetaInfos,StateId,OpName,OpTerm,NewStateId,ResTransitionIds) :- |
3489 | | get_expanded_bstate(StateId,ExpandedBState), |
3490 | | set_error_context(checking_context('VisB:','performing click event')), |
3491 | | set_context_state(StateId,perform_visb_click_event), |
3492 | | get_svgid_with_events(SvgID,_), |
3493 | | call_cleanup(perform_aux(SvgID,StateId,ExpandedBState,OpName,OpTerm,NewStateId,ResTransitionIds,MetaInfos), |
3494 | | (clear_context_state,clear_error_context)). |
3495 | | |
3496 | | get_svgid_with_events(SvgID,FirstOpName) :- visb_event(SvgID,FirstOpName,_,_,_File,_Pos). |
3497 | | |
3498 | | |
3499 | | :- use_module(probsrc(state_space),[transition/4]). |
3500 | | perform_aux(SvgID,StateId,_ExpandedBState,OpName,OpTerm,NewStateId,ResTransitionIds,_MetaInfos) :- |
3501 | | \+ b_or_z_mode, |
3502 | | % just look up transition/4 entries in state space |
3503 | | !, % TODO: maybe provide this possibility for B models, even if using explicit parameter values is more robust |
3504 | | get_visb_event_operation(SvgID,OpName,_,_Pred,_Pos), |
3505 | | if((transition(StateId,OpTerm,TransID,NewStateId), |
3506 | | match_operation(OpTerm,OpName)), |
3507 | | ResTransitionIds = [TransID], |
3508 | | return_disabled(SvgID,StateId,OpName,OpTerm,NewStateId,ResTransitionIds) |
3509 | | ). |
3510 | | perform_aux(SvgID,StateId,ExpandedBState,OpName,OpTerm,NewStateId,ResTransitionIds,MetaInfos) :- |
3511 | | %state_space:portray_state_space, |
3512 | | if(execute_visb_event_by_predicate(SvgID,StateId,ExpandedBState,OpName,OpTerm,NewStateId,TransId,MetaInfos), |
3513 | | ResTransitionIds = [TransId], % Later we may return a longer sequence of transitions |
3514 | | return_disabled(SvgID,StateId,OpName,OpTerm,NewStateId,ResTransitionIds)). |
3515 | | |
3516 | | return_disabled(SvgID,StateId,OpName,OpTerm,NewStateId,ResTransitionIds) :- |
3517 | | OpTerm = disabled, NewStateId = StateId, |
3518 | | get_svgid_with_events(SvgID,OpName), |
3519 | | ResTransitionIds = []. % visb_event not enabled |
3520 | | |
3521 | | :- use_module(probsrc(tools_strings),[match_atom/2]). |
3522 | | :- use_module(probsrc(specfile),[get_operation_name/2]). |
3523 | | match_operation(OpTerm,OpTerm) :- !. |
3524 | | match_operation(OpTerm,OpName) :- atom(OpName), |
3525 | | (get_operation_name(OpTerm,OpName) |
3526 | | ; match_atom(OpName,OpTerm) % match an atom string with a compound term |
3527 | | ),!. |
3528 | | |
3529 | | execute_visb_event_by_predicate(SvgID,StateId,ExpandedBState,OpName,OpTerm,NewStateId,TransId,MetaInfos) :- |
3530 | | get_visb_event_operation(SvgID,OpName,_,Pred,Pos), |
3531 | | build_visb_click_meta_object(MetaInfos,BMetaInfos), |
3532 | | bsyntaxtree:replace_id_by_expr(Pred,'VISB_CLICK_META_INFOS',BMetaInfos,NPred), |
3533 | | exec_aux(SvgID,StateId,ExpandedBState,OpName,NPred,Pos,OpTerm,NewStateId,TransId). |
3534 | | |
3535 | | build_visb_click_meta_object(MetaInfos,BMetaInfos) :- |
3536 | | (member(alt_key,MetaInfos) -> AltKey = pred_true ; AltKey = pred_false), |
3537 | | (member(ctrl_key,MetaInfos) -> CtrlKey = pred_true ; CtrlKey = pred_false), |
3538 | | (member(meta_key,MetaInfos) -> MetaKey = pred_true ; MetaKey = pred_false), |
3539 | | (member(pageX(PageX),MetaInfos) -> true ; PageX = 0), % fallback |
3540 | | (member(pageY(PageY),MetaInfos) -> true ; PageY = 0), % fallback |
3541 | | (member(shift_key,MetaInfos) -> ShiftKey = pred_true ; ShiftKey = pred_false), |
3542 | | findall(','(string(Var),string(VarValue)), member(js_var(Var,VarValue), MetaInfos), JSVars), |
3543 | | |
3544 | | visb_click_meta_b_type(BType), |
3545 | | BMetaInfos = b(value(rec([ |
3546 | | field(altKey,AltKey), |
3547 | | field(ctrlKey,CtrlKey), |
3548 | | field(jsVars,JSVars), |
3549 | | field(metaKey,MetaKey), |
3550 | | field(pageX,int(PageX)), |
3551 | | field(pageY,int(PageY)), |
3552 | | field(shiftKey,ShiftKey) |
3553 | | ])),BType,[visb_generated]). |
3554 | | |
3555 | | visb_click_meta_b_type(record([ |
3556 | | field(altKey,boolean), |
3557 | | field(ctrlKey,boolean), |
3558 | | field(jsVars,set(couple(string,string))), |
3559 | | field(metaKey,boolean), |
3560 | | field(pageX,integer), |
3561 | | field(pageY,integer), |
3562 | | field(shiftKey,boolean) |
3563 | | ])). |
3564 | | |
3565 | | :- use_module(probsrc(tcltk_interface),[compute_all_transitions_if_necessary/2]). |
3566 | | :- use_module(library(random),[random_member/2]). |
3567 | | :- use_module(extrasrc(mcts_game_play), [mcts_auto_play/4, mcts_auto_play_available/0]). |
3568 | | :- use_module(probsrc(tools_timeout), [time_out_with_factor_call/3]). |
3569 | | exec_aux(SvgID,StateId,ExpandedBState,OpName,Pred,Pos,OpTerm,NewStateId,TransId) :- |
3570 | | b_is_operation_name(OpName),!, |
3571 | | time_out_with_factor_call( |
3572 | | execute_operation_by_predicate_in_state_with_pos(ExpandedBState,OpName,Pred,OpTerm,NewState,Pos), |
3573 | | 5, % min_max_time_out(10,100,15000) |
3574 | | (ajoin(['TIME-OUT for VisB click on SVG ID ', SvgID,' while executing operation by predicate: '],Msg), |
3575 | | add_warning(visb_visualiser,Msg,OpName,Pos),fail)), |
3576 | | patch_state(NewState,StateId,PatchedNewState), |
3577 | | tcltk_interface:add_trans_id(StateId,OpTerm,PatchedNewState,NewStateId,TransId). |
3578 | | %translate:print_bstate(PatchedNewState),nl. |
3579 | | exec_aux(SvgID,StateId,_ExpandedBState,'MCTS_AUTO_PLAY',_Pred,Pos,OpTerm,NewStateId,TransId) :- !, |
3580 | | mcts_auto_play_available, |
3581 | | % TODO: allow to set SimRuns, TimeOut in Pred |
3582 | | add_debug_message(visb_visualiser,'Performing MCTS_AUTO_PLAY for click on: ',SvgID,Pos), |
3583 | | mcts_auto_play(StateId,OpTerm,TransId,NewStateId). |
3584 | | exec_aux(_SvgID,StateId,_ExpandedBState,'RANDOM_ANIMATE',_Pred,_Pos,OpTerm,NewStateId,TransId) :- !, |
3585 | | compute_all_transitions_if_necessary(StateId,false), |
3586 | | findall(rtr(OpTerm,TransId,NewStateId),transition(StateId,OpTerm,TransId,NewStateId),List), |
3587 | | random_member(rtr(OpTerm,TransId,NewStateId),List). |
3588 | | % see tcltk_interface:tcltk_random_perform2 and allow Kind: fully_random, no_self_loops, heuristics, ... |
3589 | | % split with ; ? |
3590 | | |
3591 | | :- use_module(probsrc(bmachine), [b_is_variable/1,b_machine_has_constants/0]). |
3592 | | |
3593 | | is_var_binding(bind(Var,_)) :- b_or_z_mode, b_is_variable(Var). |
3594 | | |
3595 | | |
3596 | | % remove constants and VisB Definition entries from state: |
3597 | | patch_state(NewState,StateId,PatchedState) :- |
3598 | | get_constants_id_for_state_id(StateId,ConstId),!, |
3599 | | PatchedState = const_and_vars(ConstId,VarsState), |
3600 | | include(is_var_binding,NewState,VarsState). |
3601 | | patch_state(NewState,StateId,VarsState) :- |
3602 | | (b_machine_has_constants |
3603 | | -> add_error(visb_visualiser,'Could not extract constants id for state:',StateId), |
3604 | | VarsState=NewState |
3605 | | ; include(is_var_binding,NewState,VarsState)). |
3606 | | |
3607 | | % the next predicate gets all operations/events associated with SvgID in the order in which they were found |
3608 | | % note that there is only one visb_event (the last one); all others are auxiliary |
3609 | | get_visb_event_operation(SvgID,OpName,Preds,TypedPred,Pos) :- % check if there are more events registered: |
3610 | | auxiliary_visb_event(SvgID,OpName,Preds,TypedPred,Pos). |
3611 | | get_visb_event_operation(SvgID,OpName,Preds,TypedPred,Pos) :- |
3612 | | visb_event(SvgID,OpName,Preds,TypedPred,_File,Pos). |
3613 | | |
3614 | | % --------------- |
3615 | | |
3616 | | get_visb_hovers(List) :- |
3617 | | findall(hover(SvgID,ID,Attr,EnterVal,ExitVal), |
3618 | | visb_hover(SvgID,ID,Attr,EnterVal,ExitVal,_), List). |
3619 | | |
3620 | | get_visb_svg_objects(List) :- |
3621 | | % TODO: remove objects inlined in get_visb_default_svg_file_contents |
3622 | | findall(visb_svg_object(SvgID,SvgClass,AttrList), |
3623 | | visb_svg_object(SvgID,SvgClass,AttrList,_Desc,_Pos), List). |
3624 | | |
3625 | | % ------------------ |
3626 | | |
3627 | | :- use_module(probsrc(bmachine),[b_absolute_file_name_relative_to_main_machine/2]). |
3628 | | extended_static_check_default_visb_file :- |
3629 | | (get_default_visb_file(VisBFile,Pos) |
3630 | | % TODO: we could check if we have an visb_history(JSONFile,_,_) option |
3631 | | -> extended_static_check_visb_file(VisBFile,Pos) |
3632 | | ; true). |
3633 | | |
3634 | | extended_static_check_visb_file('',_InclusionPos) :- |
3635 | | load_visb_file(''). |
3636 | | extended_static_check_visb_file(VisBFile,InclusionPos) :- |
3637 | | b_absolute_file_name_relative_to_main_machine(VisBFile,AFile), |
3638 | | (file_exists(AFile) |
3639 | | -> load_visb_file(AFile) |
3640 | | ; add_warning(lint,'VISB_JSON_FILE does not exist: ',AFile,InclusionPos) |
3641 | | ). |
3642 | | |
3643 | | % --------------------------- |
3644 | | |
3645 | | % portray all VisB items in DEFINITION B syntax |
3646 | | get_visb_ids(SIds) :- |
3647 | | findall(Id,visb_id(Id),Ids), |
3648 | | sort(Ids,SIds). |
3649 | | |
3650 | | visb_id(ID) :- visb_svg_object(ID,_,_,_,_). % see svg_id_exists |
3651 | | visb_id(ID) :- visb_item(ID,_,_,_,_,_,_), \+ visb_svg_object(ID,_,_,_,_). |
3652 | | visb_id(ID) :- visb_event(ID,_,_,_,_,_), \+ visb_svg_object(ID,_,_,_,_). |
3653 | | visb_id(ID) :- visb_hover(ID,_,_,_,_,_), \+ visb_svg_object(ID,_,_,_,_). |
3654 | | |
3655 | | :- public portray_visb/0. |
3656 | | portray_visb:- |
3657 | | get_visb_ids(SIds), nth1(Nr,SIds,ID), |
3658 | | %visb_svg_object(ID,SVG_Class,NewRestAttrs,Desc,Pos1), |
3659 | | findall(field(Attr,b(value(StaticVal),any,[])), |
3660 | | (visb_svg_object(ID,SVG_Class,StaticAttrs,Desc,_Pos1), |
3661 | | ( Attr=svg_class,StaticVal=string(SVG_Class) |
3662 | | ; Attr=comment,StaticVal=string(Desc) |
3663 | | ; member(svg_attribute(Attr,StaticVal),StaticAttrs)) |
3664 | | ), |
3665 | | StaticValues), |
3666 | | findall(field(Attr,TypedExpr), |
3667 | | visb_item(ID,Attr,TypedExpr,_UsedIds,_Desc,_PosStartOfItem,_Meta), % meta can contain override |
3668 | | Updates,StaticValues), |
3669 | | % TODO: incorporate events and hovers |
3670 | | UpdateRec = b(rec(Fields),any,[]), |
3671 | | gen_string(ID,IDS), |
3672 | | Fields = [field(id,IDS) | Updates], |
3673 | | (StaticValues=[] -> format('~nVISB_SVG_UPDATES~w == ',[Nr]) ; format('~nVISB_SVG_OBJECTS~w == ',[Nr])), |
3674 | | translate:print_bexpr(UpdateRec), write(';'), nl, |
3675 | | fail. |
3676 | | portray_visb. |
3677 | | gen_string(ID,b(string(ID),string,[])). |
3678 | | % use_module(visbsrc(visb_visualiser)), visb_visualiser:portray_visb. |