1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE: Env/env_java_swing.pl
    4%
    5%  AUTHOR    : Stefano Valentini
    6%  EMAIL     : 
    7%  WWW       : 
    8%  TESTED    : SWI Prolog 5.0.10 http://www.swi-prolog.org
    9%  TYPE CODE : 
   10%
   11% This files provides a .........
   12%
   13% This environment is self-contained (automatically it loads the required
   14%  libraries). It should be called as follows:
   15%
   16%   pl host=<HOST> port=<PORT> -b env_wumpus.pl -e start
   17%	idrun=<id for the run> idscenario=<id to load for fixed world>
   18%	size=<size of grid> ppits=<prob of pits> nogolds=<no of golds>
   19%	ipwumpus=<applet ip> portwumpus=<applet port>
   20%
   21% For example:
   22%
   23%   pl host='cluster1.cs.toronto.edu' port=9022 -b env_wumpus.pl -e start
   24%	idrun=test(10) idscenario=random
   25%	size=8 ppits=15 nogolds=1
   26%	ipwumpus='cluster1.cs.toronto.edu' portwumpus=9002
   27%
   28% where HOST/PORT is the address of the environment manager socket.
   29%
   30%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   31
   32:- include(env_gen).   33
   34
   35name_dev(javaswing).
   36
   37:- set_debug_level(3).   38
   39initializeInterfaces(L) :- 
   40        printKbInstructions,
   41	ground(L),
   42	set_debug_level(3),
   43	report_message(system(1), 'Building JAVA SWING Configuration'),
   44   	report_message(system(1), 'Building JAVA SWING Completed!'),
   45		% Get the locatio of the Java SWING (IP + PORT)
   46      	member([ipswing,SIP], L),   
   47      	string_to_atom(SIP, IP),
   48      	member([portswing, SP], L),
   49      	string_to_number(SP, Port),
   50	member([id,SID], L),   
   51      	string_to_atom(SID, ID),
   52	report_message(system(0), 'INITIALIZING INTERFACES!'),
   53	report_message(system(1), ['Connecting to JAVA SWING interface at ',IP,'/',Port,'/',ID]),
   54      	initializeJavaSwing(IP, Port),
   55	report_message(system(0), 'INITIALIZATION COMPLETED!').
   56	
   57
   58finalizeInterfaces(_)   :- 
   59	report_message(system(0), 'FINALIZING INTERFACES!'),
   60	finalizeJavaSwing(_,_), 
   61	%finalizeStatistics,	% SEB: PREDICATE NOT DEFINED
   62	report_message(system(0), 'FINALIZATION COMPLETED!').
   63
   64
   65
   66
   67
   68
   69
   70initializeJavaSwing(Host, Port):-
   71      	report_message(system(3), ['Establishing connection to JAVA SWING:',Host,'/',Port]), !,
   72      	socket(internet, stream, comm_java),
   73      	connect(comm_java, Host/Port),
   74      	assert(listen_to(socket, comm_java, comm_java)),
   75      	report_message(system(1), 'Connection to JAVA SWING port established successfully').
   76
   77finalizeJavaSwing(_, _) :-
   78   	report_message(system(3), ['Disconnecting from JAVA SWING']), !,
   79	listen_to(socket, comm_java, comm_java), !,	% check it is open
   80	send_command_to_swing(end, _),
   81	sleep(1),
   82	closeJavaSwingCom,
   83	report_message(system(1), 'Connection to JAVA SWING port disconnected successfully').
   84	
   85finalizeJavaSwing(_, _).	% The swing was already down
   86
   87closeJavaSwingCom :-
   88        retract(listen_to(socket, comm_java, comm_java)), % de-register interface
   89        close(comm_java).
   90
   91handle_stream(comm_java) :- 
   92        read_response_from_swing(Data),
   93        string_to_atom(Data, A),
   94        (A = end_of_file ->
   95        	% Close socket communication with swing (but device manager keeps running with no GUI)
   96            closeJavaSwingCom   
   97        ;
   98            report_exog_event(A, _)
   99	).
  100
  101
  102
  103
  104execute(Action, T, _, Sensing) :- 
  105	member(T, [sensing, simsensing]), !,
  106        report_message(action, ['Executing sensing action: *',Action,'*']),
  107        send_command_to_swing('    ------------> Enter Sensing value, terminate with ".": '),
  108        read_response_from_swing(Sensing), nl.
  109
  110execute(Action, _, _, ok) :- 
  111        report_message(action, ['Executing non-sensing action: *',Action,'*']).
  112
  113:- type_prolog(ecl) -> 
  114	set_event_handler(170, my_system_error_handler/2) ; true.  115
  116my_system_error_handler(E, Goal) :-
  117        (
  118            errno_id(`Interrupted system call`),
  119%            errno_id(170, M), errno_id(M),  % M is "Unknown error 170" ??
  120            restartable_builtin(Goal)
  121        ->
  122            call(Goal)
  123        ;
  124            errno_id(M),
  125            report_message(error, M),
  126            read(_),
  127            error(default(E), Goal)
  128        ).
  129
  130% Builtins that can raise EINTR and can be restarted after that
  131restartable_builtin(accept(_,_,_)).
  132restartable_builtin(cd(_)).
  133restartable_builtin(close(_)).
  134restartable_builtin(connect(_,_)).
  135restartable_builtin(select_stream(_,_,_)).
  136restartable_builtin(stream_select(_,_,_)).
  137restartable_builtin(wait(_,_)).
  138
  139%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  140%%%%%%%%%%%%%%%%% COMMUNICATION WITH JAVA SWING%%%%%%%%%%%%%%%%%%%%%
  141%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  142
  143
  144
  145send_command_to_swing(_, ok) :- \+ javaSwingOn, !.
  146send_command_to_swing(Command, Response) :-
  147	any_to_string(Command, SCommand),
  148	write(comm_java, SCommand),
  149	nl(comm_java),
  150	flush(comm_java), !, Response=ok.
  151%	read_response_from_swing(Response).  % Read acknowledgment from WUMPUS
  152send_command_to_swing(_, failed).
  153
  154% Read a line from swing
  155read_response_from_swing(_) :- \+ javaSwingOn, !.
  156read_response_from_swing(Command) :-
  157	read_string(comm_java, end_of_line,_, Command).
  158
  159
  160% Wumpus applet is running
  161javaSwingOn :- listen_to(socket, comm_java, comm_java).
  162	
  163
  164
  165
  166	
  167printKbInstructions :-
  168    writeln('*********************************************************'), 
  169    writeln('* NOTE: This is the JAVA SWING SIMULATOR environment*****'),
  170    writeln('*created by STEFANO VALENTINI ***************************'),
  171    writeln('*********************************************************'), nl.
  172
  173
  174
  175%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  176% EOF:  Env/env_java_swing.pl
  177%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%