1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE: lib/er1-actions.pl
    4%
    5%    WRITTEN BY: Sebastian Sardina (ssardina@cs.toronto.edu)
    6%    Time-stamp: <03/05/04 12:47:48 ssardina>
    7%    TESTED    : ECLiPSe 5.4 on RedHat Linux 6.2-7.2
    8%    TYPE CODE : system independent predicates 
    9%
   10% DESCRIPTION: mapping between ER1 low-level actions and ER1 IndiGolog actions
   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% -- actionNum(ER1-HighLevelAction, ER1-LowLevelAction)
   51%
   52%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   53
   54actionNum(clearEvents, clear).
   55actionNum(events, events).
   56
   57
   58%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   59% GRIPPER
   60%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   61% A = [auto, close, open, status, stop]
   62actionNum(gripper(A), X) :- 
   63        ground(A),
   64        concat_atom(['gripper ', A], X).
   65
   66
   67%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   68% MOVEMENT
   69%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   70% General Movement
   71actionNum(move(D,U), X) :- 
   72        ground(D), ground(U),
   73        concat_atom(['move ', D, ' ',U], X).
   74actionNum(move(D), X)   :- 
   75        ground(D),
   76        concat_atom(['move ', D, ' cm'], X).
   77
   78% Move forward and backwards 
   79actionNum(moveFwd(D), X)   :- 
   80        ground(D),
   81        concat_atom(['move ', D, ' cm'], X).
   82actionNum(moveBack(D), X)  :- 
   83        ground(D),
   84        D2 is (-1*D),
   85        concat_atom(['move ', D2, ' cm'], X).
   86
   87% Rotation 
   88actionNum(turnAround,   'move 360 degrees').
   89actionNum(turnComplete, 'move 180 degrees').
   90actionNum(turnLeft,     'move 90 degrees').
   91actionNum(turnRight,    'move -90 degrees').
   92
   93actionNum(rotateTowardsObject(O), X) :- 
   94        ground(O),
   95        concat_atom(['move rotate toward object', O], X).
   96actionNum(rotateTowardsColor(R, G, B), X) :- 
   97        ground(R), ground(G), ground(B),
   98        concat_atom(['move rotate toward color', R, ' ', G, ' ', B], X).
   99
  100actionNum(moveDriveObject(O), X) :- 
  101        ground(O),
  102        concat_atom(['move drive toward object', O], X).
  103actionNum(moveDriveColor(R, G, B), X) :- 
  104        ground(R), ground(G), ground(B),
  105        concat_atom(['move drive toward color', R, ' ', G, ' ', B], X).
  106
  107actionNum(stop, stop).
  108actionNum(freeze, stop).
  109
  110%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  111% SOUND and SPEECH
  112%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  113actionNum(speakOn, 'speak on').
  114actionNum(speakOff, 'speak off').
  115actionNum(playFile(F), X) :- 
  116        ground(F),
  117        concat_atom(['play file ', '\'', F, '\''], X).
  118actionNum(say(P), X) :- 
  119        ground(P),
  120        (is_list(P) -> concat_atom(P, Phrase) ; Phrase=P),
  121        concat_atom(['play phrase ', '\"', Phrase, '\"'], X).
  122actionNum(say(P,V), X) :- 
  123        ground(P), ground(V),
  124        (is_list(P) -> concat_atom(P, Phrase) ; Phrase=P),
  125        concat_atom(['play phrase ', '\"', Phrase, '\"', 
  126                     ' voice \"Microsoft ',V,'\"'], X).
  127
  128actionNum(selectVoice(V), X) :- 
  129        ground(V),
  130        concat_atom(['set voice ', '\'', V, '\''], X).
  131
  132
  133%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  134% SENSING ACTIONS
  135%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  136actionNum(position, 'position').
  137
  138% Turn sensor S on: S = [ir, objects, speech, sound level]
  139actionNum(senseOn(S), X) :- 
  140        ground(S),
  141        concat_atom(['sense ', S], X).
  142actionNum(senseOff(S), X) :- 
  143        ground(S),
  144        concat_atom(['sense ', S, ' off'], X).
  145
  146actionNum(senseGripper    ,'sense gripper').
  147
  148actionNum(setIR_oa(on), 'set ir oa on all 50').
  149actionNum(setIR_oa(off), 'set ir oa off').
  150actionNum(setIR_oa(N, D), X) :-
  151        ground(N), ground(D),
  152        concat_atom(['set ir oa on all ',N,' disable distance ', D], X).
  153
  154% A = [all, 1, 2, 3]
  155actionNum(senseIR(A), X) :- 
  156        ground(A),
  157        concat_atom(['ir ', A], X).
  158
  159
  160%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  161% SETTINGS
  162%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  163actionNum(setLinearVelocity(V), X) :- 
  164        ground(V),
  165        concat_atom(['set linear velocity ', V], X).
  166actionNum(setAngularVelocity(V), X) :- 
  167        ground(V),
  168        concat_atom(['set angular velocity ', V], X).
  169
  170actionNum(setPower(stopped, P), X) :- 
  171        ground(P),
  172        concat_atom(['set power stopped ', P], X).
  173actionNum(setPower(moving, P), X) :- 
  174        ground(P),
  175        concat_atom(['set power moving ', P], X).
  176
  177actionNum(setObjectConfidence(P), X) :- 
  178        ground(P),
  179        concat_atom(['set confidence threshold ', P], X).
  180
  181
  182%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  183% EXOGENOUS ACTIONS
  184%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  185% EXOGENOUS ACTIONS
  186actionNum(arrive, 'move done').
  187actionNum(finishSaying, 'play done').
  188actionNum(finishSaying, X) :- sub_atom(X,_,_,_,'play error'), !.
  189actionNum(getStuck, X) :- sub_atom(X,_,_,_,'move error'), !.
  190
  191actionNum(spotObject(Object), X) :- 
  192        get_object_event(X, Object, _, _, _, _).
  193
  194% A = lostObject <object>, e.g., lostObject warning sign
  195actionNum(lostObject(Object), A) :-
  196        string_to_atom(S, A),
  197        emptyString(Empty),
  198        string_to_atom(Space,' '),
  199        split_string(S, Space, Empty, List),
  200        List=[Type|RList],
  201        string_to_atom(Type, lostObject),   % Check it's a lost-object event
  202        join_string(RList, Space, SObject),
  203        string_to_atom(SObject, Object).
  204
  205
  206% An object stop event has the following form:
  207%   "object <name> <no features matched> <total features> <x> <x> <distance>
  208% e.g., object "warning sign" 5 30 89 89 67.6
  209get_object_event(AString, Object, Rate, X, Y, Distance) :-
  210        string_to_atom(String, AString),
  211        string_to_atom(Quote,'\"'),
  212        string_to_atom(Space,' '),
  213        split_string(String, Space, Quote, List),
  214        List=[Type|RList],
  215        string_to_atom(Type, object), % Check it's an object spot event
  216        reverse(RList, [SDistance, SY, SX, SFT, SFM|LObject]),
  217        string_to_number(SX, X),        % Get coordinate X
  218        string_to_number(SY, Y),        % Get coordinate Y
  219        string_to_number(SFT, FT),      % Get total features
  220        string_to_number(SFM, FM),      % Get features matched
  221        Rate is (100*FM)/FT,            % Calculate rate
  222        string_to_number(SDistance, Distance), % Get distance to object
  223        reverse(LObject, LObject2),
  224        join_string(LObject2, Space, SObject),   % Build the object name
  225        string_to_atom(SObject, Object)