2% :-swi_module(user). 
    3%:-swi_module(frot, [vtFrotVerb/1,frotCommand/3,frot_to_callcmd/4]).
    4/* * module *  This file defines the predicates for the agent to frotize
    5% Dec 13, 2035
    6% Douglas Miles
    7%
    8*/
    9
   10:- include(prologmud(mud_header)).   11
   12% :- register_module_type (mtCommand).
   13
   14frotCommand(Kiss,FrotVerb,frot(isOptional(vtVerb,FrotVerb),isOptional(tAgent,vHere),ftString)):-
   15  vtFrotVerb(FrotVerb), Kiss =.. [FrotVerb,isOptional(tAgent,vHere),ftString].
   16
   17vtFrotVerb(FrotVerb):-member(FrotVerb,[actKiss,actHug,actRub,actFrottage]).
   18
   19baseKB:action_info(Kiss,ftText("invokes",Does)):- frotCommand(Kiss,_FrotVerb,Does).
   20
   21baseKB:agent_text_command(Agent,[Kiss|What],Agent,CMD):-
   22   agent_text_command_frot(Agent,[Kiss|What],Agent,CMD).
   23
   24agent_text_command_frot(Agent,[Kiss|What],Agent,CMD):- nonvar(Kiss),nonvar(What),!,
   25      vtFrotVerb(Kiss),
   26      once(((frot_to_callcmd(Agent,Kiss,What,CMD),nonvar(CMD)))).
   27
   28% frot at to joe
   29frot_to_callcmd(Agent,Kiss,What,CMD):-append(Text,[Whom],What),!,frot_command_parse_2(Agent,Kiss,Whom,Text,CMD).
   30% frot at
   31frot_to_callcmd(Agent,Kiss,What,CMD):-mudAtLoc(Agent,Where),frot_command_parse_2(Agent,Kiss,Where,What,CMD).
   32
   33frot_command_parse_2(Agent,Kiss,Where,What,actProlog(actFrot(Agent,Kiss,Where,What))).
   34
   35actFrot(Agent,Kiss,Whom,Text):-
   36   mudAtLoc(Agent,Where),
   37   asInvoked(Cmd,[Kiss,Agent,Whom,Text]),
   38   raise_location_event(Where,actNotice(reciever,Cmd)).
   39
   40
   41:- if(current_module(frot)).   42:- module_meta_predicates_are_transparent(frot).   43:- module_predicates_are_exported.   44:- endif.   45
   46
   47
   48:- include(prologmud(mud_footer)).