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