1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE: Env/env_int.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 independent code
    9%  TESTED : SWI Prolog 5.0.10 http://www.swi-prolog.org
   10%           ECLIPSE 5.4 http://www.icparc.ic.ac.uk/eclipse/
   11%
   12% This files provides the environment for working with the internet/web
   13%
   14% This environment is self-contained (automatically it loads the required
   15%  libraries). It should be called as follows:
   16%
   17%   eclipse host=<HOST> port=<PORT> -b env_sim.pl -e start
   18%   pl host=<HOST> port=<PORT> -b env_sim.pl -e start
   19%
   20% where HOST/PORT is the address of the environment manager socket.
   21%
   22% Written for ECLiPSe Prolog (http://www.icparc.ic.ac.uk/eclipse/)
   23% and SWI Prolog (http://www.swi-prolog.org) running under Linux 6.2-8.0
   24%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   25%
   26%                             June 15, 2000
   27%
   28% This software was developed by the Cognitive Robotics Group under the
   29% direction of Hector Levesque and Ray Reiter.
   30%
   31%        Do not distribute without permission.
   32%        Include this notice in any copy made.
   33%
   34%
   35%         Copyright (c) 2000 by The University of Toronto,
   36%                        Toronto, Ontario, Canada.
   37%
   38%                          All Rights Reserved
   39%
   40% Permission to use, copy, and modify, this software and its
   41% documentation for non-commercial research purpose is hereby granted
   42% without fee, provided that the above copyright notice appears in all
   43% copies and that both the copyright notice and this permission notice
   44% appear in supporting documentation, and that the name of The University
   45% of Toronto not be used in advertising or publicity pertaining to
   46% distribution of the software without specific, written prior
   47% permission.  The University of Toronto makes no representations about
   48% the suitability of this software for any purpose.  It is provided "as
   49% is" without express or implied warranty.
   50% 
   51% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   52% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   53% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   54% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   55% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   56% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   57% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   58% 
   59%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   60% 
   61% This file assumes that the following is defined in env_gen.pl:
   62%
   63% -- start/0     : initialization of the environment (called when loaded)
   64% -- finalize/0  : finalization of the environment (called when exiting)
   65% -- main_dir/1  : obtain the root IndiGolog directory
   66% -- report_exog_event(A, M): 
   67%                  report exogenous event A with message M to the
   68%                  environment manager
   69% -- All compatibility libraries depending on the architecture such us:
   70%    -- compat_swi/compat_ecl compatibility libraries providing:
   71%
   72% -- The following two dynamic predicates should be available:
   73%    -- listen_to(Type, Name, Channel) 
   74%            listen to Channel of Type (stream/socket) with Name
   75%    -- terminate/0
   76%            order the termination of the application
   77%
   78% -- The following should be implemented here:
   79%
   80%  -- name_dev/1              : mandatory *
   81%  -- initializeInterfaces(L) : mandatory *
   82%  -- finalizeInterfaces(L)   : mandatory *
   83%  -- execute/4               : mandatory *
   84%  -- handle_steam/1          : as needed
   85%  -- listen_to/3             : as needed
   86%
   87%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   88:- include(env_gen).      % INCLUDE THE CORE OF THE DEVICE MANAGER
   89
   90%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   91% CONSTANTS TO BE USED
   92%
   93% name_dev/1 : state the name of the device manager (e.g., simulator, rcx)
   94%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   95
   96% Name of the environment: <SIMULATOR>
   97% Set name of the environment here.
   98% THIS CONSTANT IS MANDATORY, DO NOT DELETE!
   99name_dev(internet). 
  100
  101
  102%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  103% A - INITIALIZATION AND FINALIZATION OF INTERFACES
  104%     initializeInterfaces/1 and finalizeInterfaces/1
  105%
  106% HERE YOU SHOULD INITIALIZE AND FINALIZE EACH OF THE INTERFACES TO BE USED
  107%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  108
  109initializeInterfaces(_).
  110finalizeInterfaces(_).
  111
  112
  113%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  114% TCL/TK EXOGENOUS ACTIONS  GENERATOR - from keyboard via Tcl/Tk interface
  115%
  116% This part implements a keyboard interface to enter exogenous events
  117% in an asynchronous manner.
  118%
  119% If an exogenous event arrives via the keyboard, it is handled as soon
  120% as possible by calling handle_event/1
  121%
  122% -- initializeExog(virtual): 
  123%                    perform any initialization of other sources of
  124%                    exogenous actions that is required
  125% -- finalizeExog(virtual):
  126%                    things to do for other sources of exogenous actions
  127%                    at end of program
  128% -- checkOtherExog(virtual,-ExogList): 
  129%                    check whether a request has been entered via keyboard
  130%
  131%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  132
  133% initializeExog(tcltk): initialization for sources of exogenous actions from
  134%                        virtual interface
  135%
  136% An TCL/TK independent process is initiated to read exogenous events
  137%  the program exog.tcl writes each exogenous action entered to a special pipe.
  138% At that time, a sigio signal is assigned to such pipe so that whenever data
  139% arrives to the pipe an interrupt is triggered which can be cached
  140%  by the main cycle to handle the exog action entered.
  141tcltk_exog_file(File):- main_dir(Dir),
  142                        concat_atom([Dir,'Env/exog.tcl'], File).
  143
  144initializeExog(tcltk) :- 
  145        printKbInstructions,
  146        tcltk_exog_file(File),
  147        concat_atom(['wish ', File], Command),
  148        % Run the command as a child and send its *output*
  149        % to the pipe "tcltk"
  150        exec_group(Command, [null, tcltk, null], P),
  151        sleep(2),    % Give time to TCL/TK program to appear
  152        assert(exog_proc(P)),     % Store child pid for later
  153        assert(listen_to(stream, tcltk, tcltk)).  % listen to tcltk
  154
  155% finalizeExog: Things to do for sources of exogenous actions from the
  156%               virtual interface
  157finalizeExog(tcltk) :- 
  158        report_message(system(1), 'Closing Tcl/Tk interface.'), 
  159        retract(exog_proc(P)), 
  160        proc_kill(P).
  161
  162% printKbInstructions: Print instructions on how to enter keyboard input
  163printKbInstructions :-
  164    writeln('*********************************************************'), 
  165    writeln('* NOTE: This is the simulator environment'), 
  166    writeln('*   You can enter exogenous actions using the TCL/TK window.'), 
  167    writeln('*   Action execution will be printed here and sensing '), 
  168    writeln('*   outcome will be asked to the user'), 
  169    writeln('*********************************************************'), nl.
  170
  171
  172%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  173% B - HANDLERS FOR EACH STREAM/SOCKET THAT IS BEING HEARD:  handle_stream/1
  174%
  175% HERE YOU SHOULD WRITE HOW TO HANDLE DATA COMMING FROM EACH OF THE
  176% INTERFACES/CHANNELS USED
  177%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  178
  179% Handle all other events for stream S: sensing, exog. events, termination
  180handle_stream(S) :- 
  181             % There is data in stream S
  182	listen_to(_, action(A, N,P), S),   
  183        report_message(system(2), ['Handling data from action ',(A,N)]),
  184	read(S, Data),
  185	((Data= end_of_file ; Data=finish) ->    
  186             % Stream S is EOF or requested terminination
  187             terminate_action(N, P, S)  
  188        ;
  189        Data = [sensing, Outcome] ->
  190            report_sensing(A, N, Outcome, _)
  191	;
  192	Data = [exog_action, Action] ->
  193            report_exog_event(Action, ['Exogenous action ',Action,
  194                                       ' received from Web'])
  195	).
  196
  197% Wrap-up action number N with process Pid and stream Stream
  198terminate_action(N, Pid, Stream) :- 
  199             close(Stream),
  200             (proc_term(Pid) -> proc_wait(Pid, _) ; proc_kill(Pid)),
  201             retract(listen_to(_, action(A, N, Pid), Stream)),
  202             report_message(system(2),
  203                            ['Action ',(A, N),' has completely finished']).
  204
  205      
  206
  207
  208%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  209% C - EXECUTION MODULE: execute/4
  210%
  211% This part implements the execution capabilities of the environment
  212%
  213% execute(Action, Type, Sensing) : execute Action of Type and return Sensing
  214%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  215
  216
  217% This part implements the execution capabilities of the environment.
  218% It uses the library /lib/internet.pl where there are internet and
  219% system capabilities. Each action is a separated thread which can rise
  220% exogenous events at any time. 
  221% Executing Action means executing predicate Action in the file internet.pl
  222execute(Action, _, N, null) :- 
  223        report_message(action, ['Executing action: ', '*',Action,'*']),
  224        main_dir(Dir),
  225        string_to_term(ActionS, Action),
  226        string_to_list(ActionS, ActionL),
  227        ActionT=perform(ActionL),
  228        term_to_atom(ActionT, ActionA),
  229            % Execute Action using library internet.pl in a separate process
  230        concat_atom(['eclipse -g 4M -b ', Dir, 'lib/internet.pl -e ','\'', 
  231                     ActionA,'\''], Command),
  232        call_to_exec(unix, Command, Command2), % Select right command for exec
  233        exec(Command2, [null, Out, null], P),
  234            % Start watching out for process P of ation N through stream Out
  235            % because the action may generate exogenous events in the future
  236        assert(listen_to(stream, action(Action, N,P), Out)).
  237
  238
  239
  240%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  241% EOF:  Env/env_int.pl
  242%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%