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
   34name_dev(javaswing).
   35
   36:- set_debug_level(3).   37
   38initializeInterfaces(L) :- 
   39        printKbInstructions,
   40	ground(L),
   41	set_debug_level(3),
   42	report_message(system(1), 'Building JAVA SWING Configuration'),
   43   	report_message(system(1), 'Building JAVA SWING Completed!'),
   44		% Get the locatio of the Java SWING (IP + PORT)
   45      	member([ipswing,SIP], L),   
   46      	string_to_atom(SIP, IP),
   47      	member([portswing, SP], L),
   48      	string_to_number(SP, Port),
   49	report_message(system(0), 'INITIALIZING INTERFACES!'),
   50	report_message(system(1), ['Connecting to JAVA SWING interface at ',IP,'/',Port]),
   51      	initializeJavaSwing(IP, Port),
   52	report_message(system(0), 'INITIALIZATION COMPLETED!').
   53	
   54
   55finalizeInterfaces(_)   :- 
   56	report_message(system(0), 'FINALIZING INTERFACES!'),
   57	finalizeJavaSwing(_,_), 
   58	%finalizeStatistics,	% SEB: PREDICATE NOT DEFINED
   59	report_message(system(0), 'FINALIZATION COMPLETED!').
   60
   61
   62
   63
   64
   65
   66
   67initializeJavaSwing(Host, Port):-
   68      	report_message(system(3), ['Establishing connection to JAVA SWING:',Host,'/',Port]), !,
   69      	socket(internet, stream, comm_java),
   70      	connect(comm_java, Host/Port),
   71      	assert(listen_to(socket, comm_java, comm_java)),
   72      	report_message(system(1), 'Connection to JAVA SWING port established successfully').
   73
   74finalizeJavaSwing(_, _) :-
   75   	report_message(system(3), ['Disconnecting from JAVA SWING']), !,
   76	listen_to(socket, comm_java, comm_java), !,	% check it is open
   77	send_command_to_swing(end, _),
   78	sleep(1),
   79	closeJavaSwingCom,
   80	report_message(system(1), 'Connection to JAVA SWING port disconnected successfully').
   81	
   82finalizeJavaSwing(_, _).	% The swing was already down
   83
   84closeJavaSwingCom :-
   85        retract(listen_to(socket, comm_java, comm_java)), % de-register interface
   86        close(comm_java).
   87
   88handle_stream(comm_java) :- 
   89        read_response_from_swing(Data),
   90        string_to_atom(Data, A),
   91        (A = end_of_file ->
   92        	% Close socket communication with swing (but device manager keeps running with no GUI)
   93            closeJavaSwingCom   
   94        ;
   95            report_exog_event(A, _)
   96	).
   97
   98
   99
  100
  101execute(Action, T, _, Sensing) :- 
  102	member(T, [sensing, simsensing]), !,
  103        report_message(action, ['Executing sensing action: *',Action,'*']),
  104        send_command_to_swing('    ------------> Enter Sensing value, terminate with ".": '),
  105        read_response_from_swing(Sensing), nl.
  106
  107execute(Action, _, _, ok) :- 
  108        report_message(action, ['Executing non-sensing action: *',Action,'*']).
  109
  110:- type_prolog(ecl) -> 
  111	set_event_handler(170, my_system_error_handler/2) ; true.  112
  113my_system_error_handler(E, Goal) :-
  114        (
  115            errno_id(`Interrupted system call`),
  116%            errno_id(170, M), errno_id(M),  % M is "Unknown error 170" ??
  117            restartable_builtin(Goal)
  118        ->
  119            call(Goal)
  120        ;
  121            errno_id(M),
  122            report_message(error, M),
  123            read(_),
  124            error(default(E), Goal)
  125        ).
  126
  127% Builtins that can raise EINTR and can be restarted after that
  128restartable_builtin(accept(_,_,_)).
  129restartable_builtin(cd(_)).
  130restartable_builtin(close(_)).
  131restartable_builtin(connect(_,_)).
  132restartable_builtin(select_stream(_,_,_)).
  133restartable_builtin(stream_select(_,_,_)).
  134restartable_builtin(wait(_,_)).
  135
  136%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  137%%%%%%%%%%%%%%%%% COMMUNICATION WITH JAVA SWING%%%%%%%%%%%%%%%%%%%%%
  138%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  139
  140
  141
  142send_command_to_swing(_, ok) :- \+ javaSwingOn, !.
  143send_command_to_swing(Command, Response) :-
  144	any_to_string(Command, SCommand),
  145	write(comm_java, SCommand),
  146	nl(comm_java),
  147	flush(comm_java), !, Response=ok.
  148%	read_response_from_swing(Response).  % Read acknowledgment from WUMPUS
  149send_command_to_swing(_, failed).
  150
  151% Read a line from swing
  152read_response_from_swing(_) :- \+ javaSwingOn, !.
  153read_response_from_swing(Command) :-
  154	read_string(comm_java, end_of_line,_, Command).
  155
  156
  157% Wumpus applet is running
  158javaSwingOn :- listen_to(socket, comm_java, comm_java).
  159	
  160
  161
  162
  163	
  164printKbInstructions :-
  165    writeln('*********************************************************'), 
  166    writeln('* NOTE: This is the JAVA SWING SIMULATOR environment*****'),
  167    writeln('*created by STEFANO VALENTINI ***************************'),
  168    writeln('*********************************************************'), nl.
  169
  170
  171
  172%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  173% EOF:  Env/env_java_swing.pl
  174%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%