1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3%	ALERT!! ECLIPSE IS NOT SUPPORTED ANYMORE AS AN INDIGOLOG INTERPRETER!
    4%
    5% FILE: Elevator/main_ecl.pl
    6%
    7%  AUTHOR : Sebastian Sardina (2003)
    8%  EMAIL  : ssardina@cs.toronto.edu
    9%  WWW    : www.cs.toronto.edu/~ssardina www.cs.toronto.edu/cogrobo
   10%  TYPE   : system dependent code
   11%  TESTED : ECLiPSe 5.5 on RedHat Linux 6.2-8.0
   12%
   13% DESCRIPTION: This file is the main file for controlling the ER1 robot
   14%
   15% Written for ECLiPSe Prolog (http://www.icparc.ic.ac.uk/eclipse/)
   16% running under Linux
   17%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   18%
   19%                             June 15, 2000
   20%
   21% This software was developed by the Cognitive Robotics Group under the
   22% direction of Hector Levesque and Ray Reiter.
   23%
   24%        Do not distribute without permission.
   25%        Include this notice in any copy made.
   26%
   27%
   28%         Copyright (c) 2000 by The University of Toronto,
   29%                        Toronto, Ontario, Canada.
   30%
   31%                          All Rights Reserved
   32%
   33% Permission to use, copy, and modify, this software and its
   34% documentation for non-commercial research purpose is hereby granted
   35% without fee, provided that the above copyright notice appears in all
   36% copies and that both the copyright notice and this permission notice
   37% appear in supporting documentation, and that the name of The University
   38% of Toronto not be used in advertising or publicity pertaining to
   39% distribution of the software without specific, written prior
   40% permission.  The University of Toronto makes no representations about
   41% the suitability of this software for any purpose.  It is provided "as
   42% is" without express or implied warranty.
   43% 
   44% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   45% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   46% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   47% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   48% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   49% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   50% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   51% 
   52%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   53% 
   54% This is the top-level file for a Legolog application program.
   55% It consults all the necessary Legolog prolog files.
   56% In particular, the following is loaded:
   57%
   58%  (1) Load all libraries required. This includes the system dependant
   59%      ones for the specific Prolog plus general libraries
   60%  (2) Load the IndiGolog interpreter and the projector used
   61%  (3) Load the application code itself containing the background theory
   62%      of action plus the high-level program
   63%  (4) Specify which environments should be loaded and how 
   64%  (5) Specify how each action should be executed and how to translate
   65%      exogenous actions
   66%
   67% Moreover, the following is provided:
   68%
   69% -- main: Collects all the procedures named 'mainControl(id)' 
   70%	   and asks the user which one to run. Uses controller/1
   71%
   72%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   73
   74%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   75% SET GLOBAL PARAMETERS AND GLOBAL VARIABLES/CONSTANTS USED
   76%  
   77%  These may be options to improve performance and variables/constants used
   78%  around the whole arquitecture
   79%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   80:- dynamic controller/1.	% Stores the user decision on the controller to run
   81:- set_flag(debug_compile, off).   
   82:- set_flag(variable_names, off).  % To speed up execution
   83
   84
   85%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   86% (1) LOAD/COMPILE/IMPORT LIBRARIES, MODULES, ETC that may be required.
   87%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   88:- lib(scattered).   % Clauses can be not consecutive
   89:- lib(fd).          % Load finite-domain constraint library
   90:- lib(fd_search).   % Load extra finite-domain search algorithms
   91
   92:- use_module(library(tools_ecl)).       % General tools for Eclipse
   93:- ['../../lib/systemvar'].              % Common facts (device_manager/4)
   94
   95%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   96% (2,3) CONSULT NECESSARY FILES
   97%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   98
   99% 1 - Consult top-level IndiGolog system
  100:- ['../../Interpreters/indigolog'].     
  101
  102% 2 - Consult environment manager 
  103:- ['../../Env/env_man.pl'].   
  104
  105% 3 - Consult projector
  106:- ['../../Eval/evalbat'].     
  107
  108% 4 - Consult application
  109:- [er1test].                     % IndiGolog ER1 example
  110:- ['../../lib/er1-actions.pl'].  % Action translation for ER1
  111
  112
  113%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  114% (4,5) ENVIRONMENTS TO LOAD
  115%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  116
  117% Port of environment manager is left free and assigned by the OS
  118server_port(X).
  119
  120% Load simulator and ER1 environments
  121:- ['../../Env/dev_managers'].              % Common facts (device_manager/4)
  122load_device(Env, Command, Address) :- 
  123%        member((Env,Type), [(er1,eclipse), (simulator,eclipse)]),
  124        member((Env,Type), [(simulator,eclipse)]),
  125        (var(Address) -> 
  126             Host=null, Port=null ; 
  127             Address = [Host, Port]
  128        ),
  129        device_manager(Env, Type, Command, [Host, Port]).
  130        
  131        
  132           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  133           % HOW TO EXECUTE ACTIONS: Environment + low-level Code %
  134           %        how_to_execute(Action, Environment, Code)     %
  135           %        						  %
  136	   % Anything else is executed in the simulator           %
  137           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  138
  139how_to_execute(Action, er1, Code) :- 
  140        actionNum(Action, Code), !.   
  141
  142           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  143           %   EXOGENOUS ACTION AND SENSING OUTCOME TRANSLATION   %
  144           %          translateExogAction(Code, Action)           %
  145           %          translateSensing(Action, Outcome, Value)    %
  146           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  147translateExogAction(CodeAction, Action) :- 
  148        actionNum(Action, CodeAction).
  149
  150
  151%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  152% MAIN PREDICATE - evaluate this to run demo
  153%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  154
  155% main/0: Gets IndiGolog to evaluate a chosen mainControl procedure
  156main:- 	retractall(controller(_)),
  157	bagof(X,Y^proc(mainControl(X),Y),L),
  158    	(L=[NoContr] -> 
  159		assert(controller(NoContr))
  160    	;
  161        	write('Available Controllers: '), write(L), nl,
  162         	write('Which controller do you want to execute? '), 
  163        	read(NoContr), 
  164	 	assert(controller(NoContr))
  165    	),
  166	indigolog.
  167
  168
  169%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  170% PREDICATES WITH SYSTEM DEPENDENT CODE
  171%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  172
  173
  174:- set_option(debug_level,2).  175:- set_option(wait_step,3).  176:- set_option(type_em,signal).  177
  178
  179
  180%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  181% EOF:  Elevator/main_ecl.pl
  182%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%