1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE: Env/env_wumpus.pl
    4%
    5%  AUTHOR    : Sebastian Sardina
    6%  Time-stamp: <2005-04-24 20:37:47 ssardina>
    7%  EMAIL     : ssardina@cs.toronto.edu
    8%  WWW       : www.cs.toronto.edu/~ssardina
    9%  TESTED    : SWI Prolog 5.0.10 http://www.swi-prolog.org
   10%  TYPE CODE : system *dependent* predicates (SWI)
   11%
   12% This files provides a *simulted* wumpus world
   13%
   14% This environment is self-contained (automatically it loads the required
   15%  libraries). It should be called as follows:
   16%
   17%   pl host=<HOST> port=<PORT> -b env_wumpus.pl -e start
   18%	idrun=<id for the run> idscenario=<id to load for fixed world>
   19%	size=<size of grid> ppits=<prob of pits> nogolds=<no of golds>
   20%	ipwumpus=<applet ip> portwumpus=<applet port>
   21%
   22% For example:
   23%
   24%   pl host='cluster1.cs.toronto.edu' port=9022 -b env_wumpus.pl -e start
   25%	idrun=test(10) idscenario=random
   26%	size=8 ppits=15 nogolds=1
   27%	ipwumpus='cluster1.cs.toronto.edu' portwumpus=9002
   28%
   29% where HOST/PORT is the address of the environment manager socket.
   30%
   31% Written for ECLiPSe Prolog (http://www.icparc.ic.ac.uk/eclipse/)
   32% and SWI Prolog (http://www.swi-prolog.org) running under Linux 6.2-8.0
   33%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   34%
   35%                             March 22, 2003
   36%
   37% This software was developed by the Cognitive Robotics Group under the
   38% direction of Hector Levesque and Ray Reiter.
   39%
   40%        Do not distribute without permission.
   41%        Include this notice in any copy made.
   42%
   43%
   44%         Copyright (c) 2000 by The University of Toronto,
   45%                        Toronto, Ontario, Canada.
   46%
   47%                          All Rights Reserved
   48%
   49% Permission to use, copy, and modify, this software and its
   50% documentation for non-commercial research purpose is hereby granted
   51% without fee, provided that the above copyright notice appears in all
   52% copies and that both the copyright notice and this permission notice
   53% appear in supporting documentation, and that the name of The University
   54% of Toronto not be used in advertising or publicity pertaining to
   55% distribution of the software without specific, written prior
   56% permission.  The University of Toronto makes no representations about
   57% the suitability of this software for any purpose.  It is provided "as
   58% is" without express or implied warranty.
   59% 
   60% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   61% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   62% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   63% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   64% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   65% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   66% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   67% 
   68%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   69% 
   70% This file assumes that the following is defined in env_gen.pl:
   71%
   72% -- start/0     : initialization of the environment (called when loaded)
   73% -- finalize/0  : finalization of the environment (called when exiting)
   74% -- main_dir/1  : obtain the root IndiGolog directory
   75% -- report_exog_event(A, M): 
   76%                  report exogenous event A with message M to the
   77%                  environment manager
   78% -- All compatibility libraries depending on the architecture such us:
   79%    -- compat_swi/compat_ecl compatibility libraries providing:
   80%
   81% -- The following two dynamic predicates should be available:
   82%    -- listen_to(Type, Name, Channel) 
   83%            listen to Channel of Type (stream/socket) with Name
   84%    -- terminate/0
   85%            order the termination of the application
   86%
   87%
   88% -- The following should be implemented here:
   89%
   90%  -- name_dev/1              : mandatory *
   91%  -- initializeInterfaces(L) : mandatory *
   92%  -- finalizeInterfaces(L)   : mandatory *
   93%  -- execute/4               : mandatory *
   94%  -- handle_steam/1          : as needed
   95%  -- listen_to/3             : as needed
   96%
   97% FROM PROLOG DEPENDENT USER LIBRARY (SWI, ECLIPSE, LIBRARY):
   98%
   99% -- call_to_exec(+System, +Command, -Command2)
  100%      Command2 executes Command in plataform System
  101%
  102%
  103% Also, this device manager requires:
  104%
  105%    -- wish for running TCL/TK applications
  106%    -- exog.tcl TCL/TK script
  107%
  108%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  109:- include(env_gen).      % INCLUDE THE CORE OF THE DEVICE MANAGER
  110
  111%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  112% CONSTANTS TO BE USED
  113%
  114% name_dev/1 : state the name of the device manager (e.g., simulator, rcx)
  115%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  116
  117% Name of the environment: <SIMULATOR>
  118% Set name of the environment here.
  119% THIS CONSTANT IS MANDATORY, DO NOT DELETE!
  120name_dev(env_simwumpus). 
  121
  122% Set verbose debug level
  123:- set_debug_level(3).  124
  125%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  126% A - INITIALIZATION AND FINALIZATION OF INTERFACES
  127%     initializeInterfaces/1 and finalizeInterfaces/1
  128%
  129% HERE YOU SHOULD INITIALIZE AND FINALIZE EACH OF THE INTERFACES TO BE USED
  130%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  131/*
  132initializeInterfaces(L)
  133  append(L,[host=localhost, debug=1 ipwumpus='127.0.0.1', portwumpus=9002, ppits=10, nogolds=1, size=8,idrun='indigolog(default)' ,idscenario='random' ],L0),!,
  134  initializeInterfaces0(L0).
  135*/
  136
  137initializeInterfaces(L) :- 
  138        printKbInstructions,
  139	ground(L),
  140	set_debug_level(3),
  141	   % 0 - BUILD A VIRTUAL SCNEARIO OF THE WUMPUS WORLD
  142	   % build_random_wumpus_world(RX,RY,robDir,NoArrows,ProbPits,NoGolds),
  143	   % Probability of pit is between 0 and 100
  144	report_message(system(1), 'Building WUMPUS World Configuration'),
  145        member([idrun,SIDRun], L), string_to_term(SIDRun, IDRun),
  146        member([idscenario, SIDScenario], L), string_to_term(SIDScenario, IDScenario),
  147          % Get Size, PPits and NoGolds if available (always available for random!)
  148	(member([size,SSize], L) -> string_to_number(SSize, Size) ; true),
  149	(member([ppits,SPPits], L) -> string_to_number(SPPits, PPits) ; true),
  150	(member([nogolds,SNoGolds], L) -> string_to_number(SNoGolds, NoGolds) ; true),
  151          % Decide how to build the world: random or predefined
  152        (IDScenario=random -> 
  153		% Robot at (1,1) aiming right with 1 arrow
  154		ground(PPits), ground(NoGolds),ground(Size), % Have to be known!
  155		build_random_wumpus_world(1,1,right,1,PPits,NoGolds,Size)
  156	;
  157		% Build a fixed world using id IDScenario (get size, ppits and nogolds)
  158	        build_fixed_wumpus_world(IDScenario,[Size,PPits,NoGolds])
  159	),
  160	report_message(system(1), 'Building WUMPUS World COMPLETED!'),
  161	   % 1 - Obtain IP and Port from L
  162        member([ipwumpus,SIP], L),   
  163        string_to_atom(SIP, IP),
  164        member([portwumpus, SP], L),  % Get Host and Port of Wumpus from L
  165        string_to_number(SP, Port),
  166           % 2 - Initialize the WUMPUS WORLD Applet
  167	report_message(system(0), 'INITIALIZING INTERFACES!'),
  168	report_message(system(1), 'Initializing WUMPUS APPLET interface'),
  169        initializeWumpusWorldApplet(IP, Port),
  170	report_message(system(1), 'Initializing STATISTICS interface'),
  171	initializeStatistics(IDRun, Size, PPits,NoGolds),
  172	report_message(system(0), 'INITIALIZATION COMPLETED!').
  173	
  174	
  175finalizeInterfaces(_)   :- 
  176	report_message(system(0), 'FINALIZING INTERFACES!'),
  177	finalizeWumpusWorldApplet(_,_),	% Finalize WUMPUS virtual world
  178	finalizeStatistics,
  179	report_message(system(0), 'FINALIZATION COMPLETED!').
  180	
  181
  182
  183%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  184% A.1 - WUMPUS WORLD APPLET INTERFACE
  185%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  186% Initialize communication with WUMPUS applet
  187initializeWumpusWorldApplet(Host, Port):-
  188        report_message(system(3),
  189		['Establishing connection to WUMPUS APPLET:',Host,'/',Port]), !,
  190        socket(internet, stream, comm_wumpus),
  191        connect(comm_wumpus, Host/Port),
  192        assert(listen_to(socket, comm_wumpus, comm_wumpus)),
  193	report_message(system(1),
  194                       'Connection to WUMPUS APPLET port established successfully'),
  195        send_command_to_wumpus(reset, _),
  196	report_message(system(3), 'WUMPUS WORLD GRID RESETTED'),
  197	robot(RX,RY,_,_,_), 
  198	wumpus(WX,WY,_),
  199        send_command_to_wumpus(robot(RX,RY), _),
  200        send_command_to_wumpus(wumpus(WX,WY), _), 
  201	report_message(system(3),'ROBOT and WUMPUS PLACED'),
  202	add_all_pits,
  203	report_message(system(3),'ALL PITS PLACED'),
  204	add_all_golds,
  205	report_message(system(3),'ALL GOLDS PLACED').
  206
  207add_all_pits :-
  208	pit(PX,PY),	
  209        send_command_to_wumpus(pit(PX,PY), _), 
  210	fail.
  211add_all_pits.
  212
  213add_all_golds :-
  214	gold(PX,PY),	
  215        send_command_to_wumpus(gold(PX,PY), _), 
  216	fail.
  217add_all_golds.
  218
  219
  220% Finalize communication with WUMPUS applet
  221finalizeWumpusWorldApplet(_, _) :-
  222	listen_to(socket, comm_wumpus, comm_wumpus), !,	% check it is open
  223	send_command_to_wumpus(end, _),  % SEND "end" to WUMPUS applet
  224	sleep(1),
  225	closeWumpusAppletCom.
  226finalizeWumpusWorldApplet(_, _).	% The applet was already down
  227
  228closeWumpusAppletCom :-
  229        retract(listen_to(socket, comm_wumpus, comm_wumpus)), % de-register interface
  230        close(comm_wumpus).
  231
  232%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  233% A.2 - STATISTICS INTERFACE
  234%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  235% For each run the following clause is asserted into file 'logwumpus':
  236%	wumpus_run(IDRun,[Size,PPits,NoGolds],InitGrid,FinalGrid,History,Time)
  237%
  238initializeStatistics(IDRun, Size,PPits,NoGolds) :-
  239	findall((PX,PY),pit(PX,PY),LPits),
  240	robot(RX,RY,RD,NA,RS),
  241	wumpus(WX,WY,WS),
  242	findall((GX,GY),gold(GX,GY),LGolds),
  243	assert(initgrid([robot(RX,RY,RD,NA,RS),wumpus(WX,WY,WS),
  244		         golds(LGolds),pits(LPits)])),
  245	assert(now([])),
  246	assert(idconf(IDRun,Size,PPits,NoGolds)),
  247	statistics(real_time,_).	
  248finalizeStatistics :-
  249	robot(RX,RY,RD,NA,RS),
  250	wumpus(WX,WY,WS),
  251	findall((GX,GY),gold(GX,GY),LGolds),
  252	assert(finalgrid([robot(RX,RY,RD,NA,RS),wumpus(WX,WY,WS),golds(LGolds)])),
  253	save_statistics.
  254	
  255save_statistics :-
  256	idconf(IDRun,Size,PPits,NoGolds),	% Get identification
  257	initgrid(InitGrid),
  258	finalgrid(FinalGrid),
  259	now(H),
  260	statistics(real_time,[_,Time]),
  261	open(logwumpus,append,R),
  262	write(R, wumpus_run(IDRun,[Size,PPits,NoGolds],InitGrid,FinalGrid,H,Time)),
  263	write(R, '.'),
  264	nl(R),
  265	flush_output(R),
  266	close(R).
  267
  268% printKbInstructions: Print instructions on how to enter keyboard input
  269printKbInstructions :-
  270    writeln('*********************************************************'), 
  271    writeln('* NOTE: This is the WUMPUS WORLD JAVA-APPLET SIMULATOR environment'), 
  272    writeln('*   It handles the following actions: '), 
  273    writeln('*      move(D), smell, senseGold, senseBreeze'), 
  274    writeln('*********************************************************'), nl.
  275
  276
  277
  278%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  279% B - HANDLERS FOR EACH STREAM/SOCKET THAT IS BEING HEARD:  handle_stream/1
  280%
  281% HERE YOU SHOULD WRITE HOW TO HANDLE DATA COMMING FROM EACH OF THE
  282% INTERFACES/CHANNELS USED
  283%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  284
  285% Handle data comming from WUMPUS: 'start', 'pause', 'halt'. 
  286handle_stream(comm_wumpus) :- 
  287        read_response_from_wumpus(Data),
  288        string_to_atom(Data, A),
  289        (A=end_of_file ->
  290        	% Close socket communication with applet (but device manager keeps running with no GUI)
  291             closeWumpusAppletCom   
  292        ;
  293             report_exog_event(A, _)
  294	).
  295	
  296
  297
  298%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  299% C - EXECUTION MODULE: execute/4
  300%
  301% This part implements the execution capabilities of the environment
  302%
  303% execute(Action, Type, N, S) : execute Action of Type and outcome S
  304%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  305execute(A, T, N, S) :- 
  306	execute2(A,T,N,S),
  307	retract(now(H)),
  308	(S=failed -> A2=failed(A) ; A2=A),
  309	assert(now([A2|H])).
  310
  311
  312execute2(moveFwd, _, _, 1) :- 
  313	retract(robot(X,Y,D,NA,alive)), !,
  314	(D=up    -> up(room(X,Y),room(X2,Y2))   ;
  315	 D=down  -> down(room(X,Y),room(X2,Y2)) ;
  316	 D=left  -> left(room(X,Y),room(X2,Y2)) ;
  317	 D=right -> right(room(X,Y),room(X2,Y2))
  318	),
  319        report_message(action, ['Executing action: *',moveFwd, '*']), nl,
  320        send_command_to_wumpus(robot(X2,Y2), _),
  321        send_command_to_wumpus(write(moveFwd), _),
  322	( (pit(X2,Y2) ; wumpus(X2,Y2,alive) ; \+ get_loc(X2,Y2) ) ->
  323		assert(robot(X2,Y2,D,NA,dead))	% Here the robot dies!!
  324	;
  325		assert(robot(X2,Y2,D,NA,alive))
  326	).
  327execute2(moveFwd, _, _, failed) :- !.
  328		
  329
  330execute2(turn, _, _, 1) :- 
  331	retract(robot(X,Y,D,NA,alive)), !,
  332	(D=up    -> D2=right   ;
  333	 D=down  -> D2=left ;
  334	 D=left  -> D2=up  ;
  335	 D=right -> D2=down
  336	),
  337	assert(robot(X,Y,D2,NA,alive)),
  338        report_message(action, ['Executing action: *',turn, '*']), nl,
  339        send_command_to_wumpus(write(turn), _).
  340execute2(turn, _, _, failed) :- !.
  341
  342execute2(shootFwd, _, _, 1) :- 
  343	retract(robot(XR,YR,D,NA,alive)), NA>0, !,
  344	NA2 is NA-1,
  345	assert(robot(XR,YR,D,NA2,alive)),
  346	wumpus(XW,YW,_),
  347	(in_line(room(XR,YR),D,room(XW,YW)) -> 
  348		retract(wumpus(XW,YW,_)),
  349		assert(wumpus(XW,YW,dead)),	% The Wumpus at XW,YW died
  350	        send_command_to_wumpus(set(XW,YW,wdead), _),
  351	        report_exog_event(scream,_)	% Throw exogenous event 'scream'
  352	; 
  353		true
  354	),
  355        report_message(action, ['Executing action: *',shootFwd, '*']), nl,
  356        send_command_to_wumpus(write(shootFwd), _).
  357execute2(shootFwd, _, _, failed) :- !.
  358
  359% Using sensing and not exogenous action scream
  360execute2(shoot, _, _, Scream) :- 
  361	retract(robot(XR,YR,D,NA,alive)), NA>0, !,
  362	NA2 is NA-1,
  363	assert(robot(XR,YR,D,NA2,alive)),
  364	wumpus(XW,YW,_),
  365	(in_line(room(XR,YR),D,room(XW,YW)) -> 
  366		retract(wumpus(XW,YW,_)),
  367		assert(wumpus(XW,YW,dead)),	% The Wumpus at XW,YW died
  368		send_command_to_wumpus(set(XW,YW,wdead), _),
  369		Scream=1 			% Throw exogenous event 'scream'
  370	; 
  371		Scream=0
  372	),
  373	report_message(action, 
  374		['Executing sensing action: *',shoot,'* with outcome: ', Scream]),
  375	send_command_to_wumpus(write(shoot), _).
  376execute2(shoot, _, _, failed) :- !.
  377	
  378
  379execute2(smell, _, _, Sensing) :- 
  380	robot(X,Y,_,_,alive), !,
  381	wumpus(X2,Y2,_),
  382	(adj(room(X,Y),room(X2,Y2)) -> Sensing=1 ; Sensing=0),
  383        report_message(action, 
  384		['Executing sensing action: *',smell,'* with outcome: ', Sensing]),
  385	nl,
  386        send_command_to_wumpus(write(smell(Sensing)), _).
  387execute2(smell, _, _, failed) :- !.
  388
  389execute2(senseBreeze, _, _, Sensing) :- 
  390	robot(X,Y,_,_,alive), !,
  391	( (pit(X2,Y2),adj(room(X,Y),room(X2,Y2))) ->
  392		Sensing=1
  393	;
  394		Sensing=0
  395	),
  396        report_message(action, 
  397		['Executing sensing action: *',senseBreeze,'* with outcome: ',  
  398		Sensing]),
  399	nl,
  400        send_command_to_wumpus(write(senseBreeze(Sensing)), _).
  401execute2(senseBreeze, _, _, failed) :- !.
  402
  403execute2(senseGold, _, _, Sensing) :- 
  404	robot(X,Y,_,_,alive), !,
  405	(gold(X,Y) -> Sensing=1 ; Sensing=0),
  406        report_message(action, 
  407		['Executing sensing action: *',senseGold,'* with outcome: ', 
  408		Sensing]),
  409	nl,
  410        send_command_to_wumpus(write(senseGold(Sensing)), _).
  411execute2(senseGold, _, _, failed) :- !.
  412
  413execute2(pickGold, _, _, 1) :- !,
  414	robot(X,Y,_,_,alive), !,
  415	retractall(gold(X,Y)),
  416        report_message(action, 	['Executing action: *',pickGold,'*']),
  417	nl,
  418        send_command_to_wumpus(write(pickGold), _).
  419execute2(pickGold, _, _, failed) :- !.
  420
  421execute2(Action, _, _, ok) :- 
  422        report_message(action, ['Executing action: *',Action,'*']),
  423        send_command_to_wumpus(write(Action), _).
  424
  425
  426%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  427% MANAGEMENT OF THE VIRTUAL WUMPUS WORLD
  428%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  429:- dynamic robot/5, wumpus/3, pit/2, gold/2, gridsize/1.  430
  431% domain/2: assigns a user-defined domain to a variable. 
  432domain(V, D) :- getdomain(D, L), member(V, L).
  433% L is the list-domain associated to name D
  434getdomain(D, L) :- is_list(D) -> L=D ; (P =.. [D,L], call(P)).
  435
  436
  437/* Map Definitions */
  438gridsize(8).
  439gridindex(L) :- 
  440	gridsize(S),
  441	findall(X,get_integer(1,X,S),L).
  442directions([up,down,left,right]).
  443
  444up(room(X,Y),room(X,YN))    :- YN is Y+1. 
  445down(room(X,Y),room(X,YN))  :- YN is Y-1. 
  446right(room(X,Y),room(XN,Y)) :- XN is X+1. 
  447left(room(X,Y),room(XN,Y))  :- XN is X-1. 
  448
  449% Get any location in the grid
  450get_random_loc(X,Y) :- gridsize(S), random(1,S,X), random(1,S,Y).
  451
  452% Get every location in the grid one by one
  453get_loc(X,Y) :- gridsize(S), get_integer(1,X,S), get_integer(1,Y,S).
  454
  455
  456valid_room(room(I,J)) :- domain(I,gridindex), domain(J,gridindex).
  457adj(R1,R2) :- (up(R1,R2);down(R1,R2);left(R1,R2);right(R1,R2)),valid_room(R2).
  458
  459adj(R1,R2,D) :- adj2(R1,R2,D), valid_room(R2).
  460adj2(R1,R2,up)    :- up(R1,R2).
  461adj2(R1,R2,down)  :- down(R1,R2).	
  462adj2(R1,R2,left)  :- left(R1,R2).	
  463adj2(R1,R2,right) :- right(R1,R2).	
  464
  465% R2 is the next square of R1 in direction D
  466in_line(R1,_,R1).
  467in_line(R1,D,R2) :- adj(R1,R3,D), in_line(R3,D,R2).
  468	
  469
  470% Builds a random wumpus world map with robot at (X,Y), 
  471% Eeach square has a probability PPits of having a pit
  472% There are a total of NGolds golds in the world
  473build_random_wumpus_world(X,Y,D,NA,PPits,NGolds,Size) :-
  474	clean_grid,
  475	assert(gridsize(Size)),
  476	assert(robot(X,Y,D,NA,alive)),
  477	repeat,
  478	get_random_loc(WX,WY), empty(WX,WY), assert(wumpus(WX,WY,alive)),!,
  479%	assert(wumpus(1,7,alive)),!,	% Put the Wumpus at some fix place
  480	add_pits(PPits),	
  481	add_n_golds(NGolds).
  482	
  483% Add pits with probability Prob
  484add_pits(Prob) :-
  485	get_loc(PX,PY),	% Get a position
  486	(empty(PX,PY) ->
  487		random(1,100,N), N=<Prob, assert(pit(PX,PY))
  488	;
  489		true
  490	),
  491	fail.
  492add_pits(_).
  493
  494% Add N golds in the grid randomly		
  495add_n_golds(0).
  496add_n_golds(N) :- 
  497	repeat,
  498	get_random_loc(PX,PY),
  499	empty(PX,PY),
  500	assert(gold(PX,PY)), !,
  501	N2 is N-1,
  502	add_n_golds(N2).
  503
  504clean_grid:-
  505	retractall(gridsize(_)),
  506	retractall(robot(_,_,_,_,_)),
  507	retractall(wumpus(_,_,_)),
  508%	retractall(pit(_,_)),
  509	retractall(gold(_,_)).
  510
  511% There is no robot, no wumpus, no pit, and no gold at (PX,PY)	
  512empty(PX,PY) :-
  513	\+ robot(PX,PY,_,_,_), \+ wumpus(PX,PY,_), \+ pit(PX,PY), \+ gold(PX,PY).
  514	
  515
  516
  517% Build a fixed WUMPUS WORLD configuration
  518build_fixed_wumpus_world(IDScenario,[Size,PPits,NoGolds]) :-
  519	clean_grid,
  520	(IDScenario=none -> true ; consult('wumpus_testbed')),
  521	fixed_wumpus_world(IDScenario,[Size,PPits,NoGolds],IGrid),
  522	assert(gridsize(Size)),
  523	member(robot(IRX,IRY,IRD,INA,IRS), IGrid),
  524	member(wumpus(IWX,IWY,IWS), IGrid),
  525	member(golds(ILGolds), IGrid),
  526	member(pits(LPits), IGrid),
  527	assert(robot(IRX,IRY,IRD,INA,IRS)),
  528	assert(wumpus(IWX,IWY,IWS)),
  529	forall(member((X,Y),ILGolds), assert(gold(X,Y))),
  530	forall(member((X,Y),LPits), assert(pit(X,Y))).
  531	
  532	
  533fixed_wumpus_world(none,[10,10,1],[robot(1, 1, right, 1, alive), wumpus(2, 3, alive), golds([ (4, 6)]), pits([ (1, 2), (2, 7), (4, 4), (5, 2), (7, 4), (8, 3), (10, 1), (10, 10)])]).
  534
  535fixed_wumpus_world(IDScenario,[Size,PPits,NoGolds],IGrid) :-
  536	wumpus_run(IDScenario,[Size,PPits,NoGolds],IGrid,_,_,_).
  537
  538
  539
  540%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  541%%%%%%%%%%%%%%%%% COMMUNICATION WITH WUMPUS APPLET%%%%%%%%%%%%%%%%%%%%%
  542%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  543% Available actions:
  544%	robot(x,y) pit(x,y) gold(x,y) wumpus(x,y) reset set(x,y,string) 
  545%	write(M) : writes M in the action form
  546%	write(M) : writes M in the action form
  547
  548% Send Command to WUMPUS and wait for Response from WUMPUS
  549send_command_to_wumpus(_, ok) :- \+ wumpusAppletOn, !.
  550send_command_to_wumpus(Command, Response) :-
  551	any_to_string(Command, SCommand),
  552	write(comm_wumpus, SCommand),
  553	nl(comm_wumpus),
  554	flush(comm_wumpus), !, Response=ok.
  555%	read_response_from_wumpus(Response).  % Read acknowledgment from WUMPUS
  556send_command_to_wumpus(_, failed).
  557
  558% Read a line from WUMPUS
  559read_response_from_wumpus(_) :- \+ wumpusAppletOn, !.
  560read_response_from_wumpus(Command) :-
  561	read_string(comm_wumpus, end_of_line,_, Command).
  562
  563
  564% Wumpus applet is running
  565wumpusAppletOn :- listen_to(socket, comm_wumpus, comm_wumpus).
  566	
  567
  568%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  569% EOF:  Env/env_wumpus.pl
  570%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%