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