1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE: Env/lego_swi.pl
    4%
    5%    WRITTEN BY: First, by Maurice Pagnucco and Hector J. Levesque
    6%                Then, by Sebastian Sardina (ssardina@cs.toronto.edu)
    7%    Time-stamp: <02/11/27 17:32:28 ssardina>
    8%    TESTED    : SWI Prolog 4.0.5 under RedHat Linux 6.2/7.2
    9%    TYPE CODE : system dependent predicates
   10%
   11% DESCRIPTION: Prolog code to establish communication with 
   12%              LEGO Mindstorms RCX. This file contains the basic interface
   13%              to open, close, read and write for SWI Prolog.
   14%
   15% It is written for SWI Prolog (http://www.swi-prolog.org/) running under Linux
   16%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   17%
   18%                             June 15, 2000
   19%
   20% This software was developed by the Cognitive Robotics Group under the
   21% direction of Hector Levesque and Ray Reiter.
   22%
   23%        Do not distribute without permission.
   24%        Include this notice in any copy made.
   25%
   26%
   27%         Copyright (c) 2000 by The University of Toronto,
   28%                        Toronto, Ontario, Canada.
   29%
   30%                          All Rights Reserved
   31%
   32% Permission to use, copy, and modify, this software and its
   33% documentation for non-commercial research purpose is hereby granted
   34% without fee, provided that the above copyright notice appears in all
   35% copies and that both the copyright notice and this permission notice
   36% appear in supporting documentation, and that the name of The University
   37% of Toronto not be used in advertising or publicity pertaining to
   38% distribution of the software without specific, written prior
   39% permission.  The University of Toronto makes no representations about
   40% the suitability of this software for any purpose.  It is provided "as
   41% is" without express or implied warranty.
   42% 
   43% THE UNIVERSITY OF TORONTO DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
   44% SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
   45% FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF TORONTO BE LIABLE FOR ANY
   46% SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
   47% RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
   48% CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
   49% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
   50% 
   51%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   52%
   53% The following system dependent predicates are provided in this file:
   54%
   55% -- initRcx           : initialize serial port, baud, parity etc. for RCX
   56% -- openRcxRead       : open RCX serial port for reading
   57% -- openRcxWrite      : open RCX serial port for writing
   58% -- closeRcx          : close RCX serial port
   59% -- getRcxByte(-Ascii): get a character from RCX
   60% -- eofRcx            : succeed if there is a character from RCX to read
   61% -- putRcxByte(+Ascii): write a character to RCX
   62% -- currentTime(-Time): current system time measured in seconds
   63% -- waitUntilRcx(+End): optionally wait (busy or suspend) until End
   64%                        system time or until RCX input arrives. 
   65%                        Fails if End is passed
   66%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   67
   68% rcxStream(+Rcx): Saves the file descriptor currently referring to the open
   69%     serial port Rcx
   70:- dynamic(rcxStream/1).   71
   72% Using default Linux serial port /dev/ttyS0
   73% If you change this, make sure to alter it below in initRcx/0 as well
   74
   75% rcxPort(+Port): Location of serial port to which infrared tower is attached
   76rcxPort('/dev/ttyS0').
   77
   78% immediateDelay(+Delay): Amount of time Delay (in seconds) to wait in between
   79%     fetching bytes Linux appears to be much faster than the RCX and this
   80%     delay is used to avoid "splitting" message packets
   81immediateDelay(0.01).
   82
   83% currentTime(-Time): Returns the current system Time in hundredths of seconds
   84currentTime(Time) :-
   85    get_time(T),
   86    convert_time(T,_,_,_,H,Min,S,Mil),
   87    Time is Mil//10+S*100+Min*60000+H*24*60000.
   88
   89% initRcx: Uses stty to initialise the serial port, setting baud rate, etc.
   90%     Make sure that the serial port is set correctly. We use /dev/ttyS0 here
   91initRcx :-
   92    shell('stty -echo -icanon -iexten -isig -icrnl -inpck -istrip -ixon -cstopb cs8 parenb parodd -opost ispeed 2400 ospeed 2400 < /dev/ttyS0').
   93
   94% openRcxRead: Opens infrared tower (connected to serial port) for reading
   95%     data from RCX
   96openRcxRead :-
   97    rcxPort(Port),
   98    open(Port, read, Rcx, [eof_action(eof_code), close_on_abort(false)]),
   99    retractall(rcxStream(_)),
  100    assert(rcxStream(Rcx)).
  101
  102% openRcxWrite: Opens infrared tower (connected to serial port) for sending
  103%     data to RCX
  104openRcxWrite :-
  105    rcxPort(Port),
  106    open(Port, write, Rcx, [close_on_abort(false), buffer(false)]),
  107    retractall(rcxStream(_)),
  108    assert(rcxStream(Rcx)).
  109
  110% closeRcx: Closes infrared tower (connected to serial port) if it is
  111%     currently open. This predicate always succeeds
  112closeRcx :-
  113    (rcxStream(Rcx) ->
  114        (close(Rcx), retractall(rcxStream(Rcx))); true).
  115
  116% eofRcx: Checks whether there is any input data waiting on infrared tower
  117eofRcx :-
  118    rcxStream(Rcx),
  119    immediateDelay(Delay),
  120    wait_for_input([Rcx], ReadyList, Delay),
  121    ReadyList == [].
  122
  123% waitUntilRcx(+End): Optionally wait (busy or suspend) until End system time
  124%     or until RCX input arrives. Fail if End passed
  125waitUntilRcx(End) :-
  126    currentTime(Now),
  127    TimeOut is (End - Now)/100,
  128    TimeOut > 0,
  129    rcxStream(Rcx),
  130    wait_for_input([Rcx], _, TimeOut).
  131
  132% getRcxByte(-Ascii): Returns the first Ascii character read from infrared
  133%     tower. Blocks if there is no input
  134getRcxByte(Ascii) :-
  135    rcxStream(Rcx), 
  136    get0(Rcx, Ascii).
  137
  138% putRcxByte(+Ascii): Sends Ascii character to Rcx using infrared tower
  139putRcxByte(Ascii) :-
  140    rcxStream(Rcx),
  141    put(Rcx, Ascii), flush_output(Rcx).
  142
  143%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  144% EOF: Env/lego_swi.pl
  145%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%