1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE: lib/systemvar.pl
    4%
    5%    WRITTEN BY: Sebastian Sardina (ssardina@cs.toronto.edu)
    6%    Time-stamp: <2008-11-29 09:11:03 ssardina>
    7%    TESTED    : ECLiPSe 5.4 on RedHat Linux 6.2-7.2
    8%    TYPE CODE : system independent predicates
    9%
   10% DESCRIPTION: wide-system variables and constants
   11%
   12%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   13%
   14%                             July 9, 2002
   15%
   16% This software was developed by the Cognitive Robotics Group under the
   17% direction of Hector Levesque and Ray Reiter.
   18%
   19%        Do not distribute without permission.
   20%        Include this notice in any copy made.
   21%
   22%
   23%         Copyright (c) 2000 by The University of Toronto,
   24%                        Toronto, Ontario, Canada.
   25%
   26%                          All Rights Reserved
   27%
   28% Permission to use, copy, and modify, this software and its
   29% documentation for non-commercial research purpose is hereby granted
   30% without fee, provided that the above copyright notice appears in all
   31% copies and that both the copyright notice and this permission notice
   32% appear in supporting documentation, and that the name of The University
   33% of Toronto not be used in advertising or publicity pertaining to
   34% distribution of the software without specific, written prior
   35% permission.  The University of Toronto makes no representations about
   36% the suitability of this software for any purpose.  It is provided "as
   37% is" without express or implied warranty.
   38% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   39% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   40% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   41% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   42% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   43% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   44% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   45%
   46%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   47%
   48% The following definition of constants are provided:
   49%
   50% -- main_dir(Dir) : main directory of the whole code
   51% -- type_prolog(T) : current prolog engine is T (swi/ecl/sics/van)
   52% -- executable_path(A, P) : P is the executable path for software A
   53%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   54
   55
   56:- ensure_loaded('logicmoo_workarounds').   57
   58%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   59%%%%% AUTOMATIC LOAD OF REQUIRED LIBRARIES %%%%%%%%%%%%%%
   60%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   61% This subsection does the following:
   62%  (a) provides main_dir(Path)
   63%  (b) loads the neccessary compatibility library: compat_ecl or compat_swi
   64%  (c) sets ` to be the string construct (using set_backquoted_string)
   65
   66
   67%:- ignore((type_prolog(swi),use_module(tools_swi))).
   68
   69% Path is the root path of the IndiGolog system
   70% In SWI Pwd will be a string already
   71main_dir(Path):- getenv('PATH_INDIGOLOG',Pwd),
   72                 (string(Pwd) -> atom_string(APwd, Pwd) ; APwd=Pwd),
   73                 concat_atom([APwd, '/'], Path).
   74
   75
   76% REALIZE WHICH PROLOG WE ARE RUNNING
   77% [Code suggested by Viktor Engelmann <Viktor.Engelmann@rwth-aachen.de>]
   78
   79:- dynamic type_prolog/1.   80
   81% guess_prolog:-!.
   82
   83guess_prolog :- iso:current_prolog_flag(eclipse_info_suffix,_), !,
   84		assert(type_prolog(ecl)).
   85guess_prolog :- iso:current_prolog_flag(executable,_), !,
   86		assert(type_prolog(swi)).
   87guess_prolog :- iso:current_prolog_flag(language,sicstus), !,
   88		assert(type_prolog(sic)).
   89guess_prolog :- assert(type_prolog(vanilla)).
   90:- type_prolog(_) -> true ; guess_prolog.   91
   92
   93:- main_dir(_)->true;throw(no_main_dir).   94
   95% This is the initialization needed for each type of Prolog used
   96:- type_prolog(ecl) ->        % INITIALIZATION FOR ECLIPSE PROLOG
   97	use_module(library(tools_ecl)),
   98	set_flag(debug_compile, off),
   99	set_flag(variable_names, off),
  100	set_backquoted_string
  101	;
  102   type_prolog(swi) ->        % INITIALIZATION FOR SWI-PROLOG
  103	main_dir(Dir),
  104	concat_atom([Dir,'lib'], LibDir),
  105	assert(library_directory(LibDir)),
  106	use_module(library(eclipse_swi)), init_eclipse_lib, % ECLIPSE Compat lib
  107	use_module(library(tools_swi)),
  108	use_module(library(time)),	% for call_with_time_limit/2
  109	style_check(-discontiguous),
  110	set_prolog_flag(optimise, true),
  111	set_backquoted_string
  112	;
  113	true.  114
  115
  116
  117% Defines the path of executables used to define device managers
  118executable_path(swi, '/usr/bin/swipl').
  119executable_path(eclipse, '/opt/bin/eclipse-pl').  % if available
  120executable_path(tcltk, '/usr/bin/wish').
  121executable_path(xterm, '/usr/bin/xterm').
  122
  123
  124%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  125% EOF: lib/systemvar.pl
  126%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%