2%:-swi_module(chat, [vtSocialVerb/1,socialCommand/3,chat_to_callcmd/4]).
    3/* * module *  This file defines the predicates for the agent to socialize
    4% Dec 13, 2035
    5% Douglas Miles
    6%
    7*/
    8
    9:- include(prologmud(mud_header)).   10
   11% :- register_module_type (mtCommand).
   12
   13socialCommand(Say,SocialVerb,chat(isOptional(vtVerb,SocialVerb),isOptional(tChannel,vHere),ftString)):-
   14  vtSocialVerb(SocialVerb), Say =.. [SocialVerb,isOptional(tChannel,vHere),ftString].
   15
   16vtSocialVerb(SocialVerb):-member(SocialVerb,[actSay,actWhisper,actEmote,actTell,actAsk,actShout,actGossup]).
   17
   18baseKB:action_info(Say,ftText("invokes",Does)):- socialCommand(Say,_SocialVerb,Does).
   19
   20baseKB:agent_text_command(Agent,[Say|What],Agent,CMD):-
   21   agent_text_command_chat(Agent,[Say|What],Agent,CMD).
   22
   23agent_text_command_chat(Agent,[Say|What],Agent,CMD):- nonvar(Say),nonvar(What),!,
   24      vtSocialVerb(Say),
   25      once(((chat_to_callcmd(Agent,Say,What,CMD),nonvar(CMD)))).
   26
   27% ask joe about some text
   28chat_to_callcmd(Agent,actAsk,What,CMD):-append([Whom,about],About,What),!,chat_command_parse_2(Agent,actAsk,Whom,About,CMD).
   29% ask joe some text
   30chat_to_callcmd(Agent,actAsk,What,CMD):-append([Whom],About,What),isa(Whom,tAgent),!,chat_command_parse_2(Agent,actAsk,Whom,About,CMD).
   31% say to joe some text 
   32chat_to_callcmd(Agent,Say,What,CMD):-append([to,Whom],Text,What),!,chat_command_parse_2(Agent,Say,Whom,Text,CMD).
   33% say some text to joe
   34chat_to_callcmd(Agent,Say,What,CMD):-append(Text,[to,Whom],What),!,chat_command_parse_2(Agent,Say,Whom,Text,CMD).
   35% say some text
   36chat_to_callcmd(Agent,Say,What,CMD):-mudAtLoc(Agent,Where),chat_command_parse_2(Agent,Say,Where,What,CMD).
   37
   38chat_command_parse_2(Agent,Say,Where,What,actProlog(actSocial(Agent,Say,Where,What))).
   39
   40actSocial(Agent,Say,Whom,Text):-
   41   mudAtLoc(Agent,Where),
   42   asInvoked(Cmd,[Say,Agent,Whom,Text]),
   43   raise_location_event(Where,actNotice(reciever,Cmd)).
   44
   45
   46:- if(current_module(chat)).   47:- module_meta_predicates_are_transparent(chat).   48:- module_predicates_are_exported.   49:- endif.   50
   51
   52
   53:- include(prologmud(mud_footer)).