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