1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE: ElevatorLego-BAT/main_swi.pl
    4%
    5%  AUTHOR : Sebastian Sardina (2002)
    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 of an IndiGolog application
   12%              Elevator controller with conditional search and planning 
   13%
   14% Written for SWI Prolog http://www.swi-prolog.org/) running under Linux
   15%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   16%
   17%                             June 15, 2000
   18%
   19% This software was developed by the Cognitive Robotics Group under the
   20% direction of Hector Levesque and Ray Reiter.
   21%
   22%        Do not distribute without permission.
   23%        Include this notice in any copy made.
   24%
   25%
   26%         Copyright (c) 2000 by The University of Toronto,
   27%                        Toronto, Ontario, Canada.
   28%
   29%                          All Rights Reserved
   30%
   31% Permission to use, copy, and modify, this software and its
   32% documentation for non-commercial research purpose is hereby granted
   33% without fee, provided that the above copyright notice appears in all
   34% copies and that both the copyright notice and this permission notice
   35% appear in supporting documentation, and that the name of The University
   36% of Toronto not be used in advertising or publicity pertaining to
   37% distribution of the software without specific, written prior
   38% permission.  The University of Toronto makes no representations about
   39% the suitability of this software for any purpose.  It is provided "as
   40% is" without express or implied warranty.
   41% 
   42% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   43% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   44% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   45% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   46% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   47% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   48% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   49% 
   50%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   51% 
   52% This is the top-level file for a Legolog application program.
   53% It consults all the necessary Legolog prolog files.
   54% In particular, the following is loaded:
   55%
   56%  (1) Load all libraries required. This includes the system dependant
   57%      ones for the specific Prolog plus general libraries
   58%  (2) Load the IndiGolog interpreter and the projector used
   59%  (3) Load the application code itself containing the background theory
   60%      of action plus the high-level program
   61%  (4) Specify which environments should be loaded and how 
   62%  (5) Specify how each action should be executed and how to translate
   63%      exogenous actions
   64%
   65% Moreover, the following is provided:
   66%
   67% -- main: Collects all the procedures named 'mainControl(id)' 
   68%	   and asks the user which one to run. Uses controller/1
   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(elevator).                         
  103
  104%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  105% (4,5) ENVIRONMENTS TO LOAD
  106%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  107
  108% Port of environment manager has to be fixed in SWI
  109server_port(9113).
  110
  111% Load simulator, RCX and internet environments
  112:- ['../../Env/dev_managers'].              % Common facts (device_manager/4)
  113load_device(Env, Command, Address) :- 
  114%        member((Env,Type), [(simulator,eclipse), (rcx,eclipse), (internet,swi)]),
  115        member((Env,Type), [(simulator, swi)]),
  116        (var(Address) -> 
  117             Host=null, Port=null ; 
  118             Address = [Host, Port]
  119        ),
  120        device_manager(Env, Type, Command, [Host, Port]).
  121
  122
  123           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  124           % HOW TO EXECUTE ACTIONS: Environment + low-level Code %
  125           %        how_to_execute(Action, Environment, Code)     %
  126           %        						  %
  127	   % 	Anything else is executed in the simulator        %
  128           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  129
  130how_to_execute(Action, internet, Code) :- 
  131        actionNum(Action, Code),
  132        member(Action, [say(_)]), !.   
  133how_to_execute(Action, rcx, Code) :- 
  134        actionNum(Action, Code),
  135        \+ member(Action, [thermo]), !.       % Exceptions 
  136
  137
  138           %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  139           %   EXOGENOUS ACTION AND SENSING OUTCOME TRANSLATION   %
  140           %          translateExogAction(Code, Action)           %
  141           %          translateSensing(Action, Outcome, Value)    %
  142	   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  143
  144translateExogAction(CodeAction, Action) :- actionNum(Action, CodeAction).
  145
  146translateSensing(check(_,_), SensorValue, true):- 
  147	number(SensorValue),
  148	(SensorValue<30 ; SensorValue>40), !.
  149translateSensing(check(_,_), N, false) :- number(N).
  150
  151
  152%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  153% MAIN PREDICATE - evaluate this to run demo
  154%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  155
  156% main/0: Gets IndiGolog to evaluate a chosen mainControl procedure
  157main:- 	retractall(controller(_)),
  158	bagof(X,Y^proc(mainControl(X),Y),L),
  159    	(L=[NoContr] -> 
  160		assert(controller(NoContr))
  161    	;
  162        	write('Available Controllers: '), write(L), nl,
  163         	write('Which controller do you want to execute? '), 
  164        	read(NoContr), 
  165	 	assert(controller(NoContr))
  166    	),
  167	indigolog.
  168
  169
  170:- set_option(debug_level,2).  171:- set_option(wait_step,3).  172
  173%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  174% EOF: ElevatorLego-BAT/main_swi.pl
  175%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%