1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2% FILE: Wumpus/main_ecl.pl
    3%
    4%  AUTHOR    : Stavros Vassos & Sebastian Sardina
    5%  email     : {stavros,ssardina}@cs.toronto.edu
    6%  WWW       : www.cs.toronto.edu/cogrobo
    7%  TESTED    : ECLIPSE PROLOG
    8%  TYPE CODE : system dependent predicates
    9%
   10% DESCRIPTION: This file is the main file of an IndiGolog application
   11%              of the Wumpus World.
   12%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   13%                             June 15, 2000
   14%
   15% This software was developed by the Cognitive Robotics Group under the
   16% direction of Hector Levesque and Ray Reiter.
   17%
   18%        Do not distribute without permission.
   19%        Include this notice in any copy made.
   20%
   21%
   22%         Copyright (c) 2000 by The University of Toronto,
   23%                        Toronto, Ontario, Canada.
   24%
   25%                          All Rights Reserved
   26%
   27% Permission to use, copy, and modify, this software and its
   28% documentation for non-commercial research purpose is hereby granted
   29% without fee, provided that the above copyright notice appears in all
   30% copies and that both the copyright notice and this permission notice
   31% appear in supporting documentation, and that the name of The University
   32% of Toronto not be used in advertising or publicity pertaining to
   33% distribution of the software without specific, written prior
   34% permission.  The University of Toronto makes no representations about
   35% the suitability of this software for any purpose.  It is provided "as
   36% is" without express or implied warranty.
   37% 
   38% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   39% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   40% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   41% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   42% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   43% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   44% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   45% 
   46%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
   47% This is the top-level file for a Legolog application program.
   48% It consults all the necessary Legolog prolog files.
   49% In particular, the following is loaded:
   50%
   51%  (1) Load all libraries required. This includes the system dependant
   52%      ones for the specific Prolog plus general libraries
   53%  (2) Load the IndiGolog interpreter and the projector used
   54%  (3) Load the application code itself containing the background theory
   55%      of action plus the high-level program
   56%  (4) Specify which environments should be loaded and how 
   57%  (5) Specify how each action should be executed and how to translate
   58%      exogenous actions
   59%
   60% Moreover, the following is provided:
   61%
   62% -- main: Collects all the procedures named 'mainControl(N)' where
   63%          N is the number representing the N-th controller.
   64%          The user can select which controller to execute and the 
   65%          IndiGolog executor will be run on such controller
   66%
   67%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   68%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   69
   70
   71%%%%%%%%%%%%%%
   72% SET GLOBAL PARAMETERS AND GLOBAL VARIABLES/CONSTANTS USED
   73%  
   74%  These may be options to improve performance and variables/constants used
   75%  around the whole arquitecture
   76%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   77:- set_flag(debug_compile, off).   
   78:- set_flag(variable_names, off).  % To speed up execution
   79
   80type_prolog(ecl).    % Type of Prolog being used
   81
   82
   83
   84%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   85% (1) LOAD/COMPILE/IMPORT LIBRARIES, MODULES, ETC that may be required.
   86%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   87:- lib(scattered).   % Clauses can be not consecutive
   88:- lib(fd).          % Load finite-domain constraint library
   89:- lib(fd_search).   % Load extra finite-domain search algorithms
   90%:- lib(lists).	     % Used for shuffle/2
   91
   92:- use_module(library(tools_ecl)).       % General tools for Eclipse
   93:- ['../../lib/systemvar'].              % Common facts (device_manager/4)
   94
   95
   96%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   97% (2,3) CONSULT NECESSARY FILES
   98%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   99
  100% 1 - Consult the IndiGolog system: top-level and evaluator
  101:- ['../../Interpreters/indigolog'].  102
  103:- ['../../Interpreters/flux/flux'].  104
  105% 2 - Consult environment manager 
  106:- ['../../Env/env_man.pl'].  107
  108% 3 - Consult projector
  109
  110% 4 - Consult application
  111:- ['wumpus'].  112
  113
  114%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  115% (4,5) ENVIRONMENTS TO LOAD
  116%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  117:- dynamic wumpus_config/5.  118
  119% Port of environment manager has to be fixed in SWI
  120server_port(_).
  121server_host('localhost').
  122
  123wumpus_config(flux(default),8,10,1,random).  % Default conf: 
  124
  125% 8x8 size, 10/100 prob of pit and 4 golds in grid
  126% This requires a file wumpustestbed.pl with all the conf info
  127%wumpus_config(rerun(82),8,10,1,nmar05test(9)).  
  128
  129% Load simulator, RCX and internet environments
  130:- ['../../Env/dev_managers'].              % Common facts (device_manager/4)
  131load_device(Env, Command, Address) :- 
  132%       member((Env,Type), [(virtual_wumpus_silent, swi)]),
  133       member((Env,Type), [(virtual_wumpus, swi)]),
  134        (var(Address) -> 
  135             Host=null, Port=null ; 
  136             Address = [Host, Port]
  137        ),
  138        device_manager(Env, Type, Command, [Host, Port]).
  139
  140           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  141           % HOW TO EXECUTE ACTIONS: Environment + low-level Code %
  142           %        how_to_execute(Action, Environment, Code)     %
  143           %        						  %
  144	   % Anything else is executed in the simulator           %
  145           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  146
  147%how_to_execute(Action, virtual_wumpus_silent, Action).
  148how_to_execute(Action, virtual_wumpus, Action).
  149
  150           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  151           %   EXOGENOUS ACTION AND SENSING OUTCOME TRANSLATION   %
  152           %          translateExogAction(Code, Action)           %
  153           %          translateSensing(Action, Outcome, Value)    %
  154           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  155translateExogAction(Action, Action).
  156
  157
  158%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  159% MAIN PREDICATE - evaluate this to run demo
  160%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  161main:- 	init, 
  162	writeln('Starting to execute WUMPUS with FLUX'),
  163	(main_wumpus -> true ; true), 
  164	writeln('Finishing to execute WUMPUS with FLUX'),
  165	fin.
  166initializeDB.
  167finalizeDB.
  168
  169
  170full_test :-
  171	member(Size,[8]),
  172	member(PPits,[20,30,40]),
  173	member(NoGolds,[1,2,4]),
  174	writeln('=================================================='),
  175	write('TEST WUMPUS: '), write((Size,PPits,NoGolds)), nl,
  176	once(retract(wumpus_config(_,_,_,_,_))),
  177	once(retract(gridsize(_))),
  178	assert(gridsize(Size)),
  179		% Set up Size, PPits and NoGolds (only)
  180	assert(wumpus_config(test,Size,PPits,NoGolds,scenario)),
  181	test(301,1),
  182	fail.
  183full_test :- 
  184	writeln('=================================================='),
  185	writeln('DONE!').
  186
  187
  188% test Wumpus Max number of times repetitively
  189test(Max,Max) :-!, 
  190	writeln('FINISHED TESTING....').
  191test(Max,N) :-
  192	write('TESTING INSTANCE: '), write(N),
  193	write(' (Out of '), write(Max), write(' runs)'), nl,
  194	tell('/dev/null'),
  195	retract(wumpus_config(_,Size,PPits,NoGolds,_)),
  196		% Assert the type of execution it is going to be done next!
  197	assert(wumpus_config(nmar05testFlux(N),Size,PPits,NoGolds,nmar05test(N))),
  198%	assert(wumpus_config(fluxtest(N),Size,PPits,NoGolds,random)),
  199	main,	% RUN FLUX PROGRAM!
  200	sleep(1),
  201	tell(user),
  202	N2 is N+1,
  203	test(Max, N2).	
  204	
  205
  206
  207%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  208% PREDICATES WITH SYSTEM DEPENDENT CODE
  209%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  210
  211:- set_option(debug_level,2).  212:- set_option(wait_step,0).  213:- set_option(type_em,signal).  214%:- set_option(type_em,eventafter).
  215
  216
  217
  218
  219
  220
  221%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  222% EXECUTION OF ACTIONS
  223%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  224
  225%:- dynamic now/1.
  226perform(A, S) :-
  227	now(H),
  228	perform(A,H,CS),	% CS is a list of sensing codes (0/1)
  229	maplist(translateSensing,CS,S),
  230	update_now([o(A,S)|H]).
  231
  232perform(sense, H, [S2,S1,S3]) :-
  233	execute_action(smell, H, S1), S1\=failed,
  234	execute_action(senseBreeze, H, S2), S2\=failed,
  235	execute_action(senseGold, H, S3), S3\=failed.
  236perform(turn, H, []) :-
  237	execute_action(turn, H, S), S\=failed.
  238perform(enter, H, S2) :-
  239	execute_action(enter, H, S), S\=failed,
  240	perform(sense, H, S2).
  241perform(exit, H, []) :-
  242	execute_action(climb, H, S), S\=failed.
  243perform(shoot, H, [S]) :-
  244	execute_action(shoot, H, S), S\=failed.
  245perform(go, H, S2) :-
  246	execute_action(moveFwd, H, S), S\=failed,
  247	perform(sense, H, S2).
  248perform(grab, H, []) :-
  249	execute_action(pickGold, H, S), S\=failed.
  250
  251translateSensing(0, false).
  252translateSensing(1, true).
  253
  254% interface to the execute_action/5 in the EM (env_man.pl)
  255execute_action(Action, H, Outcome) :-
  256	execute_action(Action, H, _, _, Outcome).
  257
  258
  259%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  260% EOF:  Wumpus/main_ecl.pl
  261%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%