:-op(200,fx,('$')).

% default Tcl/Tk server port
% the Tcl/Tk server needs to be used only if Prolog calls Tcl/Tk

that_port(8001).

% this_port(7001). % default for this server

server:-prolog_server.

% another server, reusing most of the previous
prolog_server:-
  server_action(tcl_server_action)=>>run_server.
 
tcl_server_action(ServiceSocket):-
  socket(ServiceSocket)=>>tcl_server_step(ServiceSocket).

tcl_server_step(Socket):-
  server_try(Socket,sock_readln(Socket,Question)),
  process_tcl_line(Question,Answer),
  server_try(Socket,sock_writeln(Socket,Answer)).

process_tcl_line(Qs,As):-
  %write_chars("TRACE: GETTING>"),write_chars(Qs),nl, % trace
  term_chars(Q,Qs),
  %write_chars("TRACE: EXTRACTING"),println(Q), % trace
  process_tcl_query(Q,A),
  %write_chars("TRACE: ANSWERING"),println(Q), % trace
  pl2tcl(A,As),
  !.
process_tcl_line(_,"no").

% line client operations
tcl_client_action(Host,Port,Question,Answer):-
  println(tcl_client_action(Host,Port,Question)), %%$
  new_client(Host,Port,Socket),
  socket(Socket)=>>tcl_client_step(Socket,Question,Answer),!,
  println(tcl_client_action(Answer)), %%$
  close_socket(Socket).

% sends Query gets back Answer on Socket
% note that this requires "aaa" instead of 'aaa' to be sent
% this has the advantage of only internalizing useful data
tcl_client_step(Socket,Qs,As):-
  client_try(Socket,sock_writeln(Socket,Qs)),
  client_try(Socket,sock_readln(Socket,As)),
  quietmes(1,tcl_client_step(Socket,Qs,As)),
  !.
tcl_client_step(_,_,"no").

%%% edit here if you want to change behavioir of client or server

/**
  Specifies how the server reacts to client requests.
  Note that while serving Tcl/Tk, the server can handle ordinary Prolog queries as well
  through the usual the/3 mechanism - and possibly forward to proxies if needed
*/
process_tcl_query(the(Answer,Goal,Password),R):-!,
  check_password(Password)->the(Answer,Goal,R)
; R=error_invalid_password(Password).
process_tcl_query(Answer^Goal,R):-!,the(Answer,call_prolog(Goal),R).
process_tcl_query(Goal,R):-!,the(Goal,call_prolog(Goal),R).
process_tcl_query(Goal,invalid_command(Goal)).

/**
  Calls a Tcl server after building a Tcl term and returns the answer
*/
  call_tcl(Q,A):-pl2tcl(Q,Qs),ask_tcl_server(Qs,As),term_chars(A,As).

/**
  Sends/receives Q/A as list of chars
*/
ask_tcl_server(Qs,As):-
  client_action(tcl_client_action)=>>ask_server(Qs,As).

/**
  Sends/receives Q/A as Prolog terms
*/
ask_tcl(Q,A):-term_chars(Q,Qs),ask_tcl_server(Qs,As),term_chars(A,As).

/**
  test repeated Q/A s
*/
tcl_chat:-
  default_login(I),name(I,Is),
  repeat,
  (read_line(L),term_chars(L,Cs)->
    det_append(Is,": ",Head),
    append(Head,Cs,Mes),
    ask_tcl_server(Mes,_),
    fail
  ; true
  ),
  !.

% Prolog to TCL converter

pl2tcl(T,Cs):-pl2tcl(T,Cs,[]).

pl2tcl(X)-->{var(X)},!,{errmes(unexpected_in(tcl),var(X))}.
pl2tcl(X)-->{number(X)},!,{term_chars(X,Cs)},paste_chars(Cs),space.
pl2tcl(X)-->{atom(X)},!,{term_chars(X,Cs)},paste_chars(Cs),space.
pl2tcl('$'(X))-->!,{ val(X,X,V);V='$'(X)},!,{term_chars(V,Vs)},paste_chars(Vs),space.
pl2tcl([X|Xs])-->!,"{",pl2tcl(X),tcl_cmd(Xs),"}",space.
pl2tcl({Xs})-->!,"{",pl2tcl(Xs),"}",space.
pl2tcl((X,Xs))-->!,pl2tcl(X),pl2tcl(Xs).
pl2tcl(T)-->{T=..[F|Xs]},begin_script(F,Xs,Ys),tcl_cmd(Ys),end_script(F).

begin_script(script,Xs,Xs)-->!,"[".
begin_script(F,Xs,[F|Xs])-->"{".

end_script(script)-->!,"]",space.
end_script(_)-->"}",space.

tcl_cmd([X|Xs])-->!,pl2tcl(X),tcl_cmd(Xs).
tcl_cmd([])-->[].

paste_chars([])-->[].
paste_chars([C|Cs])-->[C],paste_chars(Cs).

space-->" ".