1% :-swi_module(user). 
    2%:-swi_module(get_set, []).
    3/* * module * Agent changes one of their own variables
    4% Douglas Miles 2014
    5
    6*/
    7:- include(prologmud(mud_header)).    8
    9% :- register_module_type (mtCommand).
   10
   11baseKB:action_info(actGet(isOptional(ftTerm,isSelfAgent),tPred),ftText("@get term to a property")).
   12baseKB:action_info(actSet(isOptional(ftTerm,isSelfAgent),tPred,ftTerm),ftText("@sets term to a property")).
   13
   14baseKB:agent_text_command(Agent,["@set",Prop0,Value0],Agent,actSet(Agent,Prop0,Value0)).
   15baseKB:agent_text_command(Agent,["@get",Prop0],Agent,actGet(Agent,Prop0)).
   16baseKB:agent_text_command(Agent,["@","set",Prop0,Value0],Agent,actSet(Agent,Prop0,Value0)).
   17baseKB:agent_text_command(Agent,["@","get",Prop0],Agent,actGet(Agent,Prop0)).
   18baseKB:agent_text_command(Agent,["@_set",Prop0,Value0],Agent,actSet(Agent,Prop0,Value0)).
   19baseKB:agent_text_command(Agent,["@_get",Prop0],Agent,actGet(Agent,Prop0)).
   20
   21baseKB:agent_call_command(Agent,actSet(Obj0,Prop0,Value0)) :- coerce(Prop0,tPred,Prop,Prop0),subst(ain(t(Prop,Obj0,Value0)),isSelfAgent,Agent,K),dmsg(K),on_x_debug(K).
   22
   23baseKB:agent_call_command(Agent,actGet(Obj0,Prop0)) :- subst(t(Prop0,Obj0,Value),isSelfAgent,Agent,K), 
   24                                                        catch((findall(Value,(req1(K),fmt(K)),L),
   25                                                          (L==[_|_]->true;fmt(wasMissing(K)))),E,fmt('@get Error ~q',[E:K])).
   26
   27:- include(prologmud(mud_footer)).