1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE: Elevator-BAT/main_swi.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 : SWI Prolog 5.0.10 http://www.swi-prolog.org
   10%
   11% DESCRIPTION: This file is the main file for controlling the ER1 robot
   12%
   13% Written for SWI Prolog http://www.swi-prolog.org/) running under Linux
   14%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   15%
   16%                             June 15, 2000
   17%
   18% This software was developed by the Cognitive Robotics Group under the
   19% direction of Hector Levesque and Ray Reiter.
   20%
   21%        Do not distribute without permission.
   22%        Include this notice in any copy made.
   23%
   24%
   25%         Copyright (c) 2000 by The University of Toronto,
   26%                        Toronto, Ontario, Canada.
   27%
   28%                          All Rights Reserved
   29%
   30% Permission to use, copy, and modify, this software and its
   31% documentation for non-commercial research purpose is hereby granted
   32% without fee, provided that the above copyright notice appears in all
   33% copies and that both the copyright notice and this permission notice
   34% appear in supporting documentation, and that the name of The University
   35% of Toronto not be used in advertising or publicity pertaining to
   36% distribution of the software without specific, written prior
   37% permission.  The University of Toronto makes no representations about
   38% the suitability of this software for any purpose.  It is provided "as
   39% is" without express or implied warranty.
   40% 
   41% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   42% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   43% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   44% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   45% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   46% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   47% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   48% 
   49%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   50% 
   51% This is the top-level file for a Legolog application program.
   52% It consults all the necessary Legolog prolog files.
   53% In particular, the following is loaded:
   54%
   55%  (1) Load all libraries required. This includes the system dependant
   56%      ones for the specific Prolog plus general libraries
   57%  (2) Load the IndiGolog interpreter and the projector used
   58%  (3) Load the application code itself containing the background theory
   59%      of action plus the high-level program
   60%  (4) Specify which environments should be loaded and how 
   61%  (5) Specify how each action should be executed and how to translate
   62%      exogenous actions
   63%
   64% Moreover, the following is provided:
   65%
   66% -- main: Collects all the procedures named 'mainControl(id)' 
   67%	   and asks the user which one to run. Uses controller/1
   68%
   69%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   70
   71
   72%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   73% SET GLOBAL PARAMETERS AND GLOBAL VARIABLES/CONSTANTS USED
   74%  
   75%  These may be options to improve performance and variables/constants used
   76%  around the whole arquitecture
   77%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   78:- dynamic controller/1.	% Stores the user decision on the controller to run
   79
   80
   81%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   82% (1) LOAD/COMPILE/IMPORT LIBRARIES, MODULES, ETC that may be required.
   83%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   84:- include('../../lib/systemvar'). % Global include code and Prolog init
   85%:- reset_backquoted_string.
   86
   87
   88%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   89% (2,3) CONSULT NECESSARY FILES
   90%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   91
   92% 1 - Consult the top-level interpreter
   93:- consult('../../Interpreters/indigolog').   
   94
   95% 2 - Consult environment manager 
   96:- consult(['../../Env/env_man.pl']).         
   97
   98% 3 - Consult the projector
   99:- consult('../../Eval/evalbat').             
  100
  101% 4 - Consult application
  102:- consult(er1test).                         
  103:- ['../../lib/er1-actions.pl'].  % Action translation for ER1
  104
  105%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  106% (4,5) ENVIRONMENTS TO LOAD
  107%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  108
  109% Port of environment manager has to be fixed in SWI
  110server_port(9127).
  111
  112% Load simulator and ER1 environments
  113:- ['../../Env/dev_managers'].              % Common facts (device_manager/4)
  114load_device(Env, Command, Address) :- 
  115        member((Env,Type), [(er1,swi), (simulator,swi)]),
  116        %member((Env,Type), [(simulator,swi)]),
  117        (var(Address) -> 
  118             Host=null, Port=null ; 
  119             Address = [Host, Port]
  120        ),
  121        device_manager(Env, Type, Command, [Host, Port]).
  122
  123
  124           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  125           % HOW TO EXECUTE ACTIONS: Environment + low-level Code %
  126           %        how_to_execute(Action, Environment, Code)     %
  127           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  128
  129how_to_execute(Action, er1, Code) :- 
  130        actionNum(Action, Code), !.   
  131
  132
  133           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  134           %   EXOGENOUS ACTION AND SENSING OUTCOME TRANSLATION   %
  135           %          translateExogAction(Code, Action)           %
  136           %          translateSensing(Action, Outcome, Value)    %
  137           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  138
  139translateExogAction(CodeAction, Action) :- actionNum(Action, CodeAction).
  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
  165    
  166:- set_option(debug_level,5).  167:- set_option(wait_step,3).  168
  169
  170%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  171% EOF: Elevator-BAT/main_swi.pl
  172%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%