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
   78/* ECL
   79:- set_flag(debug_compile, off).   
   80:- set_flag(variable_names, off).  % To speed up execution
   81type_prolog(ecl).    % Type of Prolog being used
   82*/
   83
   84:- ensure_loaded('../../lib/logicmoo_workarounds').   85
   86
   87%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   88% (1) LOAD/COMPILE/IMPORT LIBRARIES, MODULES, ETC that may be required.
   89%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   90/* ECL
   91:- lib(scattered).   % Clauses can be not consecutive
   92:- lib(fd).          % Load finite-domain constraint library
   93:- lib(fd_search).   % Load extra finite-domain search algorithms
   94%:- lib(lists).	     % Used for shuffle/2
   95
   96:- use_module(library(tools_ecl)).       % General tools for Eclipse
   97*/
   98
   99:- ['../../lib/systemvar'].              % Common facts (device_manager/4)
  100
  101
  102%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  103% (2,3) CONSULT NECESSARY FILES
  104%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  105
  106% 1 - Consult the IndiGolog system: top-level and evaluator
  107:- ['../../Interpreters/indigolog'].  108
  109:- ['../../Interpreters/flux/flux'].  110
  111% 2 - Consult environment manager 
  112:- ['../../Env/env_man.pl'].  113
  114% 3 - Consult projector
  115
  116% 4 - Consult application
  117:- ['wumpus'].  118
  119
  120%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  121% (4,5) ENVIRONMENTS TO LOAD
  122%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  123:- dynamic wumpus_config/5.  124
  125% Port of environment manager has to be fixed in SWI
  126server_port(_).
  127server_host('localhost').
  128
  129wumpus_config(flux(default),8,10,1,random).  % Default conf: 
  130
  131% 8x8 size, 10/100 prob of pit and 4 golds in grid
  132% This requires a file wumpustestbed.pl with all the conf info
  133%wumpus_config(rerun(82),8,10,1,nmar05test(9)).  
  134
  135% Load simulator, RCX and internet environments
  136:- ['../../Env/dev_managers'].              % Common facts (device_manager/4)
  137load_device(Env, Command, Address) :- 
  138%       member((Env,Type), [(virtual_wumpus_silent, swi)]),
  139       member((Env,Type), [(virtual_wumpus, swi)]),
  140        (var(Address) -> 
  141             Host=null, Port=null ; 
  142             Address = [Host, Port]
  143        ),
  144        device_manager(Env, Type, Command, [Host, Port]).
  145
  146           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  147           % HOW TO EXECUTE ACTIONS: Environment + low-level Code %
  148           %        how_to_execute(Action, Environment, Code)     %
  149           %        						  %
  150	   % Anything else is executed in the simulator           %
  151           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  152
  153%how_to_execute(Action, virtual_wumpus_silent, Action).
  154how_to_execute(Action, virtual_wumpus, Action).
  155
  156           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  157           %   EXOGENOUS ACTION AND SENSING OUTCOME TRANSLATION   %
  158           %          translateExogAction(Code, Action)           %
  159           %          translateSensing(Action, Outcome, Value)    %
  160           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  161translateExogAction(Action, Action).
  162
  163
  164%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  165% MAIN PREDICATE - evaluate this to run demo
  166%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  167main:- 	init, 
  168	writeln('Starting to execute WUMPUS with FLUX'),
  169	(main_wumpus -> true ; true), 
  170	writeln('Finishing to execute WUMPUS with FLUX'),
  171	fin.
  172initializeDB.
  173finalizeDB.
  174
  175
  176full_test :-
  177	member(Size,[8]),
  178	member(PPits,[20,30,40]),
  179	member(NoGolds,[1,2,4]),
  180	writeln('=================================================='),
  181	write('TEST WUMPUS: '), write((Size,PPits,NoGolds)), nl,
  182	once(retract(wumpus_config(_,_,_,_,_))),
  183	once(retract(gridsize(_))),
  184	assert(gridsize(Size)),
  185		% Set up Size, PPits and NoGolds (only)
  186	assert(wumpus_config(test,Size,PPits,NoGolds,scenario)),
  187	test(301,1),
  188	fail.
  189full_test :- 
  190	writeln('=================================================='),
  191	writeln('DONE!').
  192
  193
  194% test Wumpus Max number of times repetitively
  195test(Max,Max) :-!, 
  196	writeln('FINISHED TESTING....').
  197test(Max,N) :-
  198	write('TESTING INSTANCE: '), write(N),
  199	write(' (Out of '), write(Max), write(' runs)'), nl,
  200	tell('/dev/null'),
  201	retract(wumpus_config(_,Size,PPits,NoGolds,_)),
  202		% Assert the type of execution it is going to be done next!
  203	assert(wumpus_config(nmar05testFlux(N),Size,PPits,NoGolds,nmar05test(N))),
  204%	assert(wumpus_config(fluxtest(N),Size,PPits,NoGolds,random)),
  205	main,	% RUN FLUX PROGRAM!
  206	sleep(1),
  207	tell(user),
  208	N2 is N+1,
  209	test(Max, N2).	
  210	
  211
  212
  213%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  214% PREDICATES WITH SYSTEM DEPENDENT CODE
  215%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  216
  217:- set_option(debug_level,2).  218:- set_option(wait_step,0).  219:- set_option(type_em,signal).  220%:- set_option(type_em,eventafter).
  221
  222
  223
  224
  225
  226
  227%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  228% EXECUTION OF ACTIONS
  229%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  230
  231%:- dynamic now/1.
  232perform(A, S) :-
  233	now(H),
  234	perform(A,H,CS),	% CS is a list of sensing codes (0/1)
  235	maplist(translateSensing,CS,S),
  236	update_now([o(A,S)|H]).
  237
  238perform(sense, H, [S2,S1,S3]) :-
  239	execute_action(smell, H, S1), S1\=failed,
  240	execute_action(senseBreeze, H, S2), S2\=failed,
  241	execute_action(senseGold, H, S3), S3\=failed.
  242perform(turn, H, []) :-
  243	execute_action(turn, H, S), S\=failed.
  244perform(enter, H, S2) :-
  245	execute_action(enter, H, S), S\=failed,
  246	perform(sense, H, S2).
  247perform(exit, H, []) :-
  248	execute_action(climb, H, S), S\=failed.
  249perform(shoot, H, [S]) :-
  250	execute_action(shoot, H, S), S\=failed.
  251perform(go, H, S2) :-
  252	execute_action(moveFwd, H, S), S\=failed,
  253	perform(sense, H, S2).
  254perform(grab, H, []) :-
  255	execute_action(pickGold, H, S), S\=failed.
  256
  257translateSensing(0, false).
  258translateSensing(1, true).
  259
  260% interface to the execute_action/5 in the EM (env_man.pl)
  261execute_action(Action, H, Outcome) :-
  262	execute_action(Action, H, _, _, Outcome).
  263
  264
  265%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  266% EOF:  Wumpus/main_ecl.pl
  267%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%