xtl_interface

abolish_all(Preds) :-
    abolish(Preds, [force(true),tree(true)]).

consult_without_redefine_warning(File) :-
    get_set_optional_prolog_flag(redefine_warnings, Old, off),
    get_set_optional_prolog_flag(single_var_warnings, Old2, off),
    (catch(my_compile(File),
    error(existence_error(_,_),_),
    add_error_fail(xtl,'XTL File does not exist:',File))
    -> OK=true ; OK=false),
    get_set_optional_prolog_flag(redefine_warnings, _, Old),
    get_set_optional_prolog_flag(single_var_warnings, _, Old2),
    OK=true.

copy_args_to_b(dot(X),Y) :- !,translate_and_normalise_arg_to_b(X,Y). /* is this still required with the new eval ?? */

copy_args_to_b(in(X),Y) :- !,translate_and_normalise_arg_to_b(X,Y).

copy_args_to_b(out(X),Y) :- !,translate_and_normalise_arg_to_b(X,Y).

copy_args_to_b(X,Y) :- translate_and_normalise_arg_to_b(X,Y).

csp_initialisation_for_b(NewState) :- cspm_main_process(MAIN),
    (animatable_process_without_arguments(MAIN) -> get_start_expr(MAIN,NewState);
    (animatable_process_without_arguments(X)
    -> add_error(csp_transition_for_b,'No MAIN process in the CSP file! I am animating:',X),
    NewState = val_of(X)
    ; add_error(csp_transition_for_b,'No animatable process in the CSP file!'), NewState = stop)
).

csp_transition_for_b(State,Ch,Args,Action,NewState) :- State \= root,
    % print(cspm_trans_enum(State,Action,NewState)),nl,
    cspm_trans_enum(State,Action,NewState), %% TO DO: delay enumeration until B operation has been setup ?
    % print(cspm_trans_enum(Action,NewState)),nl,
    decompose_event(Action,Ch,Args).

cspm_main_process('MAIN').

cspm_property(State,Property) :-
    translate_cspm_state(State,Property).

cspm_transition(root,start_cspm_MAIN,NormalisedNewState) :-
    cspm_main_process(MAIN),
    animatable_process_without_arguments(MAIN),
    get_start_expr(MAIN,NewState),
    normalise_cspm_state(NewState,NormalisedNewState).

cspm_transition(root,start_cspm(X),NormalisedNewState) :- cspm_main_process(MAIN),
    (get_preference(cspm_animate_all_processes_without_arguments,true)
    ; \+ animatable_process_without_arguments(MAIN)),
    animatable_process_without_arguments(X),
    X\=MAIN,
    get_start_expr(X,NewState),
    normalise_cspm_state(NewState,NormalisedNewState).

cspm_transition(root,start_cspm(X),NormalisedNewState) :- cspm_main_process(MAIN),
    get_preference(cspm_animate_all_processes,true),
    animatable_process(X),
    X\=MAIN,
    get_start_expr(X,NewState),
    normalise_cspm_state(NewState,NormalisedNewState).

cspm_transition(root,io([V1],print,no_loc_info_available),root) :-
    cspPrintCompiled(Expr,CompiledExpr), debug_println(9,cspPrintCompiled(Expr,CompiledExpr)),
    nl, translate:print_csp_value(Expr),
    print(' == '), nl, print(' '),
    force_evaluate_argument(CompiledExpr,V1),
    translate:print_csp_value(V1),nl.

cspm_transition(root,no_process_to_animate,root) :-
    ( get_preference(cspm_animate_all_processes,true) ->
    \+ animatable_process(_)
    ; \+ animatable_process_without_arguments(_)).

cspm_transition(State,Action,NormalisedNewState) :- State \= root,
    %print(comp),nl,
    cspm_trans_enum(State,Action,NewState),
    normalise_cspm_state(NewState,NormalisedNewState).

decompose_event(io(V,Ch,_Src),Ch,V).

decompose_event(tau(S),tau(S),[]).

decompose_event(tick(S),tick(S),[]).

generate_b_operationargs_from_csp(V,BArgs) :- l_copy_args_to_b(V,BArgs).

get_atom_string(Atom,Res) :- atom(Atom),!,Res=Atom.

get_atom_string([H|T],Res) :- safe_atom_codes(Atom,[H|T]), !, Res=Atom. % transform "abc" into 'abc'

get_atom_string(R,R).

get_start_expr(Proc,val_of(Proc,Span)) :- get_symbol_span(Proc,Span).

is_deferred_set_element_name(DeferredSetEl,fd(Nr,Set)) :- atomic(DeferredSetEl),
    b_global_sets:b_global_deferred_set(Set), atom_codes(Set,SetCodes),
    append(SetCodes,NrCodes,DC),
    safe_atom_codes(DeferredSetEl,DC),
    catch(number_codes(Nr,NrCodes),_,fail).

l_copy_args_to_b(tail_in(X),[Y]) :- translate_and_normalise_arg_to_b(X,Y).

l_copy_args_to_b([],[]).

l_copy_args_to_b([HCSP|T],[HB|TB]) :-
    copy_args_to_b(HCSP,HB),
    l_copy_args_to_b(T,TB).

l_translate_arg_to_b([],[]).

l_translate_arg_to_b([H|T],[TH|TT]) :- translate_arg_to_b(H,TH),
    l_translate_arg_to_b(T,TT).

my_compile(F) :- %get_preference(user_is_an_expert_with_accessto_source_distribution,true),
    !, % it seems it is ok to call compile also in probcli binary; it may do consult though
    compile(F).

my_compile(F) :- consult(F).

open_cspm_file(File) :-
    retractall(last_opened_cspm_file(_)),
    debug_println(15,open_cspm_file(File)), flush_output(user_output),
    parse_and_load_cspm_file(File),
    assertz(last_opened_cspm_file(File)).

open_xtl_file(File) :-
    abolish_all([prop/2, trans/3, start/1]),
    abolish_all([animation_image/2,animation_function_result/2,
    animation_image_click_transition/6,animation_image_right_click_transition/3,
    heuristic_function_active/0,
    prob_pragma_string/2,
    prob_game_info/3]),
    assertz((heuristic_function_active :- fail)),
    assertz((animation_image(_,_) :- fail)),
    assertz((animation_function_result(_,_) :- fail)),
    assertz((animation_image_click_transition(_,_,_,_,_,_) :- fail)),
    assertz((animation_image_right_click_transition(_,_,_) :- fail)),
    assertz((prob_pragma_string(_,_) :- fail)),
    assertz((prob_game_info(_,_,_) :- fail)),
    debug_println(9,tcltk_open_xtl_file(File)),
    consult_without_redefine_warning(File),
    debug_println(9,new_xtl_file(File)).

reset_cspm_main_process :- set_cspm_main_process('MAIN').

reset_xtl_interface :- retractall(last_opened_cspm_file(_)),
    reset_cspm_main_process.

set_cspm_main_process(M) :-
    retractall(cspm_main_process(_)),
    assertz(cspm_main_process(M)).

translate_and_normalise_arg_to_b(CSP,BN) :- translate_arg_to_b(CSP,B), normalise_value_for_var(csp,true,B,BN).

translate_arg_to_b(X,X) :- var(X),!.

translate_arg_to_b(X,int(X)) :- number(X),!,print_message(converted_int(X)).

translate_arg_to_b(fd(N,S),fd(N,S)) :- !. /* copy B SET element across */

translate_arg_to_b(string(S),string(S)) :- !. /* copy B STRING element across */

translate_arg_to_b(int(N),int(N)) :- !.

translate_arg_to_b(true,pred_true /* bool_true */) :- !.

translate_arg_to_b(false,pred_false /* bool_false */) :- !.

translate_arg_to_b(global_set(N),global_set(N)) :- !.

translate_arg_to_b(freetype(N),freetype(N)) :- !.

translate_arg_to_b(avl_set(N),avl_set(N)) :- !.

translate_arg_to_b(closure(A,B,C),closure(A,B,C)) :- !.

translate_arg_to_b(closure(A,B,C,E),closure(A,B,C,E)) :- !.

translate_arg_to_b(setValue(S),R) :- !, translate_arg_to_b(S,R1),
    construct_avl_from_lists(R1,R).

translate_arg_to_b(list(L),R) :- !, translate_list_to_b(L,1,R1),
    custom_explicit_sets:construct_avl_from_lists(R1,R).

translate_arg_to_b([],[]) :- !.

translate_arg_to_b([H|T],[TH|TT]) :- !,translate_arg_to_b(H,TH), translate_arg_to_b(T,TT).

translate_arg_to_b((H,T),(TH,TT)) :- !,translate_arg_to_b(H,TH), translate_arg_to_b(T,TT).

translate_arg_to_b(na_tuple(L),Res) :- !,l_translate_arg_to_b(L,TL),
    convert_list_into_pairs(TL,Res).

translate_arg_to_b(Constant,BRep) :- translate_b_constant(Constant,BRep),!. /* clause necessary?? */

translate_arg_to_b(term(Constant),BRep) :- translate_b_constant(Constant,BRep),!.

translate_arg_to_b(term(N),term(N)) :- !.

translate_arg_to_b(DeferredSetEl,FD) :-
    is_deferred_set_element_name(DeferredSetEl,FD),!.

translate_arg_to_b(X,string(X)) :- atomic(X),!. % if the identfier X is not known: translate it to a string

translate_arg_to_b(X,term(X)) :- add_error(translate_arg_to_b,'Unknown CSP datatype, cannot convert to B:',X).

translate_b_constant(GS,BRep) :- nonvar(GS),b_global_set(GS),all_elements_of_type(GS,BRep),!.

translate_b_constant(Constant,BRep) :- nonvar(Constant),b_global_sets:lookup_global_constant(Constant,BRep),!.

translate_list_to_b([],_,[]).

translate_list_to_b([H|T],Nr,[(int(Nr),TH)|TT]) :- translate_arg_to_b(H,TH),
    N1 is Nr+1, translate_list_to_b(T,N1,TT).

xtl_animation_function_result(State,AnimationMatrix) :- State \= root,
    animation_function_result(State,AnimationMatrix).

xtl_animation_image(Nr,PathToGif) :-
    %on_exception(error(existence_error(_,_),_),
    animation_image(Nr,PathToGif).

xtl_animation_image_click_transition(FromX,FromY,ToX,ToY,OperationTemplate,Image) :-
    animation_image_click_transition(FromX,FromY,ToX,ToY,OperationTemplate,Image).

xtl_animation_image_right_click_transition(X,Y,OperationTemplate) :-
    animation_image_right_click_transition(X,Y,OperationTemplate).

xtl_game_info(Key,State,Value) :- prob_game_info(Key,State,Value).

xtl_get_definition_string(Def_Name,DefString) :-
    prob_pragma_string(N,S),
    get_atom_string(N,Def_Name),
    get_atom_string(S,DefString).

xtl_goal_found(State) :- xtl_property(State,goal).

xtl_heuristic_function_active :-
    heuristic_function_active.

xtl_heuristic_function_result(State,int(IntegerVal)) :- State \= root,
    heuristic_function_result(State,Res),
    (Res=int(R) -> IntegerVal=R
    ; number(Res) -> IntegerVal=Res
    ; add_error(xtl_heuristic_function_result,'heuristic_function_result must be integer: ',Res),fail
).

xtl_invariant_violated(State) :- xtl_property(State,unsafe).

xtl_property(State,Property) :- State \= root, prop(State,Property).

xtl_transition(root,start_xtl_system,NewState) :- start(NewState).

xtl_transition(State,Operation,NewState) :- State \= root, trans(Operation,State,NewState).