1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%  FILE      : Env/env_gen.pl
    3%
    4%  AUTHOR : Sebastian Sardina (2003)
    5%  EMAIL  : ssardina@cs.toronto.edu
    6%  WWW    : www.cs.toronto.edu/~ssardina www.cs.toronto.edu/cogrobo
    7%  TYPE   : system independent code
    8%  TESTED : SWI Prolog 5.0.10 http://www.swi-prolog.org
    9%           ECLIPSE 5.4 http://www.icparc.ic.ac.uk/eclipse/
   10%
   11% This files provides the core of a device manager. The user should later
   12% finish the device by providing the implementation of initializeInterface/0,
   13% finalizeInterface/0, handle_stream/1, and execute/4.
   14%
   15% This file is self-contained (automatically it loads the required
   16%  libraries). It should be called as follows:
   17%
   18%   eclipse host=<HOST> port=<PORT> -b env_rcx.pl -e start
   19%
   20% where HOST/PORT is the address of the environment manager socket.
   21%
   22%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   23%
   24%                             March 22, 2003
   25%
   26% This software was developed by the Cognitive Robotics Group under the
   27% direction of Hector Levesque and Ray Reiter.
   28%
   29%        Do not distribute without permission.
   30%        Include this notice in any copy made.
   31%
   32%
   33%         Copyright (c) 2000 by The University of Toronto,
   34%                        Toronto, Ontario, Canada.
   35%
   36%                          All Rights Reserved
   37%
   38% Permission to use, copy, and modify, this software and its
   39% documentation for non-commercial research purpose is hereby granted
   40% without fee, provided that the above copyright notice appears in all
   41% copies and that both the copyright notice and this permission notice
   42% appear in supporting documentation, and that the name of The University
   43% of Toronto not be used in advertising or publicity pertaining to
   44% distribution of the software without specific, written prior
   45% permission.  The University of Toronto makes no representations about
   46% the suitability of this software for any purpose.  It is provided "as
   47% is" without express or implied warranty.
   48% 
   49% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   50% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   51% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   52% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   53% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   54% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   55% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   56% 
   57%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   58% 
   59%
   60% This file defines the following predicates:
   61%
   62% -- start      : initialization of the environment (called when loaded)
   63% -- finalize   : finalization of the environment (called when exiting)
   64% -- main_dir/1 : defines the IndiGolog root directory
   65% -- report_exog_event(+A, +M) 
   66% 		report exogenous event A with message M to the environment manager
   67% -- report_sensing(+A, +N, +S, +M)
   68%		report sensing outcome S from action A with number N and message M
   69% -- change_action_state(+A,+N,+State,+Sensing,+LExogEvents): 
   70%         change the state of Action-N to State, set its Sensing and the list of
   71%         exogenous events generated due to the action
   72%
   73%
   74% 
   75% plus handle_stream(env_manager) for handling messages from the 
   76% environment manager.
   77%
   78% Required: 
   79%
   80%    -- ECLIPSE compatibility library
   81%
   82%
   83% In order to complete a device manager the user should implement:
   84%
   85%  -- name_dev/1              : mandatory *
   86%  -- initializeInterfaces(L) : mandatory *
   87%  -- finalizeInterfaces(L)   : mandatory *
   88%  -- execute/4               : mandatory *
   89%  -- handle_steam/1          : as needed
   90%  -- listen_to/3             : as needed
   91%
   92%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   93:- dynamic terminate/0,    % To signal when the environment should quit
   94           listen_to/3.    % Streams and Sockets to look after
   95
   96%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   97% CONSTANTS and main_dir/1 definintion
   98%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   99
  100:- include('../lib/systemvar'). % Global include code and Prolog init
  101
  102wait_until_close(5). % how many seconds to wait until closing the device manager
  103
  104
  105% Close a stream and always succeed
  106safe_close(StreamId) :-
  107        catch_succ(myclose(StreamId), ['Could not close socket ', StreamId]).
  108myclose(Id) :- close(Id).
  109
  110
  111%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  112%%%%% START OF STANDARD SECTION %%%%%%%%%%
  113%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  114
  115start :- catch_fail(start2,'Main cycle for device manager got exception').
  116start :-  
  117	report_message(error, 'For some reason the environment has stopped'),
  118	halt_device.
  119
  120
  121% Run at the beginning of the environment setting
  122% It initializes the communication with the environment manager and
  123% it initializes every source of input (rcx, tcl/tk, etc.)
  124start2 :- 
  125        name_dev(EnvId), 
  126    	    report_message(system(1), ['Initializing environment ', EnvId]),  
  127               % 1 - Obtain Host and Port number of env. manager from command 
  128        get_argument(host, SHost),
  129        get_argument(port, SPort),
  130        string_to_atom(SHost, Host),
  131        string_to_number(SPort, Port),
  132        assert(env_manager(Host, Port)),  % Store info about manager
  133               % 2 - Set debug level if appropiate option was given
  134        (get_argument(debug, SDebugLevel) ->
  135		string_to_number(SDebugLevel, DebugLevel),
  136		set_debug_level(DebugLevel),
  137	        report_message(system(1), ['Setting debug level to ',DebugLevel])
  138	;
  139	        true
  140	),
  141               % 3 - Setup stream socket with environment manager
  142	        report_message(system(1),'Setting socket connection with env. manager'), 
  143        sleep(3),  % Give time to environment manager to wait for us
  144        catch_fail(socket(internet, stream, env_manager),'Cannot open socket'),
  145        catch_fail(connect(env_manager, Host/Port),'Cannot connect to EM'),
  146               % 4- We should listen to env_manager
  147        assert(listen_to(socket, env_manager, env_manager)),  
  148               % 5 - Initialize different interfaces
  149	         % The manager may have been called with special arguments
  150	         % Example: the IP and Port of the robot plataform
  151	         % Then we read all command line arguments into CLArg
  152        get_list_arguments(CLArgs), 
  153        report_message(system(1), 'Initializing required interfaces...'), 
  154        initializeInterfaces(CLArgs),   %%%%%%%%%%% USER SHOULD IMPLEMENT THIS!
  155               % 6 - Run the main cycle
  156        	report_message(system(1), 'Starting main cycle'), !,
  157        main_cycle,
  158               % 7 - Terminate environment
  159    	    report_message(system(1), 'Finalizing domain interfaces...'), !,
  160        finalize(CLArgs),
  161	        report_message(system(1), 'Device manager totally finished; about to halt...'),
  162	    halt_device.
  163
  164halt_device :-
  165		(wait_until_close(Seconds) -> true ; Seconds = 5),
  166		sleep(Seconds),		% Hold for Seconds and then close
  167		halt.
  168
  169
  170% Run when the environment is closed. 
  171% It should close all sockets, streams, pipes opened
  172finalize(CLArgs) :- 
  173        report_message(system(3), 'Start closing device....'),
  174        finalizeInterfaces(CLArgs),  %%%%%%%%%%% USER SHOULD IMPLEMENT THIS!
  175        close_all_sockets.	    % Close all interfaces that were opened
  176        
  177
  178% halt device after waiting for some seconds (so that one can read debug info)
  179break_device :-
  180        report_message(system(1), 'Device manager breaking..'),
  181	break.
  182
  183
  184% Close all sockets for which there is a listen_to/3 entry
  185close_all_sockets :-
  186        retract(listen_to(socket, _, X)),
  187        safe_close(X),
  188		fail.
  189close_all_sockets.
  190
  191
  192
  193% MAIN CYCLE: Wait for data to arrive from data comming from the
  194%             environment manager or any interface that was initialized
  195%             and stored in listen_to/3.
  196%             Here we wait for the tcl/tk pipe and the env_manager socket
  197%
  198% listen_to(Type, Id, X) means that X should be checked at every cycle
  199main_cycle :- 
  200        repeat,
  201           % Make a set LStreams with all sockets and streams with data
  202        findall(Stream, listen_to(stream, _, Stream), LStreams1),
  203        findall(Stream, listen_to(socket, _, Stream), LStreams2),
  204        append(LStreams1, LStreams2, LStreams),
  205        report_message(system(3),['Waiting the following streams: '|LStreams]),
  206        stream_select(LStreams, block, ReadyStreams),   % Wait for input (block)
  207           % Handle all the streams that have data
  208        report_message(system(3),['Streams ready: '|ReadyStreams]),
  209        handle_streams(ReadyStreams),    
  210        (terminate -> true ; fail). 
  211
  212% order termination of the device manager
  213order_device_termination :- terminate -> true ; assert(terminate).
  214
  215%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  216% HANDLERS FOR INPUT ON STREAMS (event manager and interfaces)
  217%
  218% This section implements how each stream is handled when input arrives
  219%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  220:- dynamic handle_stream/1.  % NEEDED BECAUSE IT MAY BE DEFINED IN 2 FILES!
  221
  222% Handle a list of streams where there is info waiting
  223handle_streams([]).
  224handle_streams([S|LS]) :- 
  225        handle_stream(S), !, 
  226        handle_streams(LS).
  227
  228% Standard handler for the event manager stream: 
  229% called when the environment manager sent something 
  230% usually, there is no need to modify it, one should implement execute/3
  231handle_stream(env_manager) :- 
  232        report_message(system(3),'Handling data on env_manager'),
  233        receive_data_socket(env_manager, [_, Data]),
  234	((Data = [terminate] ; Data = [system, end_of_file]) -> 
  235             report_message(system(2), ['Termination requested. Reason: ', Data]),
  236             order_device_termination 
  237        ;
  238         Data = [execute, N, Type, Action] ->
  239	     change_action_state(Action, N, orderExecution, null, []),
  240	     report_message(system(3), ['About to execute *',(Action,N),'*']), 
  241             (execute(Action, Type, N, S) -> 
  242		report_message(system(3),['Action *',(Action,N),'* executed with outcome: ',S])
  243	     ; 
  244		report_message(error,['Action *',(Action,N),'* could not execute (assumed failed)']),
  245		S=failed
  246	     ),
  247%	     change_action_state(Action, N, finalExecution,S,[]),
  248             % Report the sensing if it was not "null" (null=not available yet)
  249             % If it was null, then the user should make sure that the
  250             % sensing outcome will be eventually reported to the manager
  251             (S \=null -> report_sensing(Action, N, S, _) ; true)
  252        ;
  253             report_message(warning,['Uknown message from Manager: ', Data])
  254        ).
  255
  256
  257
  258%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  259% TOOL FOR REPORTING EXOGENOUS EVENT AND SENSING TO THE ENVIRONMENT MANAGER
  260%
  261%  report_exog_event(A, M)
  262%       report exogenous event A and message M to the environment manager
  263%  report_sensing(A, N, S, M) 
  264%       report sensing outcome S for action A with number N and print
  265%       message M 
  266%
  267% The device managers use this tool to report the occurrence of exogenous
  268% events/actions and action sensing outcomes. 
  269% Message is a message that should be printed in the device manager output.
  270%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  271report_exog_event(A, Message) :- var(Message), !,
  272        report_message(exogaction, ['Exogenous action ',A,' occurred']),
  273        send_data_socket(env_manager, [exog_action, A]).
  274report_exog_event(A, Message) :- 
  275        report_message(exogaction, Message),
  276        send_data_socket(env_manager, [exog_action, A]).
  277
  278report_sensing(A, N, S, Message) :- var(Message), !,
  279        report_message(sensing, ['Sending sensing to manager:  ', (A,N,S)]),
  280        send_data_socket(env_manager,[sensing, N, S]).
  281report_sensing(_, N, S, Message) :- 
  282        report_message(sensing, Message),
  283        send_data_socket(env_manager,[sensing, N, S]).
  284
  285
  286
  287
  288%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  289% change_action_state(A,N,State,Sensing,LExogEvents): 
  290%    change the state of Action-N to State, set its Sensing and the list of
  291%    exogenous events generated due to the action
  292%
  293% State can be:
  294%      orderExecution  : order of execution received but still not executed
  295%      finalExecute    : action finished execution with sensing outcome S
  296%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  297% Stores action number, state, sensing outcome, and associated exogenous events
  298:- dynamic actionState/4.   
  299
  300change_action_state(_, N, orderExecution, _, _) :- !,
  301	assert(actionState(N, orderExecution, null, [])).
  302change_action_state(_, N, State, Sensing, LExog) :-
  303	retract(actionState(N,OldState,OldSensing,OldExog)),
  304	(var(State)   -> NewState=OldState ; NewState=State),
  305	(var(Sensing) -> NewSensing=OldSensing ; NewSensing=Sensing),
  306	(var(LExog)   -> NewExog=OldExog ; append(LExog,OldExog,NewExog)),
  307	assert(actionState(N,NewState,NewSensing,NewExog)).
  308
  309
  310%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  311% EOF:  Env/env_gen.pl
  312%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%