1% :-swi_module(user). 
    2:-swi_module(modHelp, [actHelp/0]).    3/* * module * A command to tell an agent all the possible commands
    4% help.pl
    5% Douglas Miles 2014
    6*/
    7:- include(prologmud(mud_header)).    8
    9% :- register_module_type (mtCommand).
   10
   11isa(tHumanControlled,ttAgentType).
   12%genls(ttAgentType,tCol).
   13
   14:- kb_global(baseKB:type_action_info/3).   15
   16baseKB:type_action_info(tHumanControlled,actHelp(isOptional(ftString,"")), "shows this help").
   17
   18
   19:-export(get_all_templates/1).   20
   21get_all_templates(Templ):- no_repeats(get_all_templates0(Templ)).
   22
   23:-export(good_template/1).   24good_template(Templ):- \+ contains_singletons(Templ).
   25
   26get_all_templates0(Templ):-get_good_templates(Templ).
   27get_all_templates0(Templ):-get_bad_templates(Templ),not(get_good_templates(Templ)).
   28
   29get_good_templates(Templ):- isa(Templ,vtActionTemplate),good_template(Templ).
   30% get_good_templates(Templ):- no_repeats_old((baseKB:action_info(Templ,_),good_template(Templ))).
   31
   32
   33get_bad_templates(Templ):- no_repeats_old((baseKB:action_info(Templ,_),not(good_template(Templ)))).
   34
   35
   36:- sanity((fully_expand_real(foo,baseKB:action_info(TEMPL, txtConcatFn(_Text,"does: ",do(_A2,TEMPL))),O),dmsg(O))).   37
   38% :- mpred_core:import(baseKB:get_agent_text_command_0/4).
   39
   40/*
   41==> ((({between(1,5,L),length(Text,L),
   42     get_agent_text_command(_A,Text,A2,Goal),(ground(Goal)->TEMPL=Goal;TEMPL=Text)}==>
   43         baseKB:action_info(TEMPL, txtConcatFn(Text,"does: ",do(A2,TEMPL)))))).
   44*/
   45
   46(action_rules(_Agent,Verb,[Obj|Objs],List),{atomic(Verb),safe_univ(Syntax,[Verb,Obj|Objs])} ==> 
   47         baseKB:action_info(Syntax, txtConcatFn(["makes","happen"|List]))).
   48
   49
   50to_param_doc(TEMPL,["Prolog", "looks", "like", ":",TEMPL]):-!.
   51to_param_doc(TEMPL,S):-sformat(S,'Prolog looks like: ~q',[TEMPL]).
   52
   53
   54first_pl((BODY,_),PL):- nonvar(BODY),!,
   55 first_pl(BODY,PL).
   56first_pl(PL,PL).
   57
   58:- kb_shared(action_info_db/3).   59
   60action_info_db(TEMPL,INFO,WAS):- (PRED=baseKB:agent_call_command(_,WAS);PRED=baseKB:agent_text_command(_,_,_,WAS)) ,
   61   clause(PRED,BODY,REF),clause_property(REF,file(S)),
   62   (ground(WAS)->true;once(( ignore((nop(S=S),first_pl(BODY,PL),ignore(catch(((true;quietly(PL)),!),_,true)))),ground(WAS)))),
   63   
   64    (TEMPL=@=WAS -> ((clause_property(REF,line_count(LC)),INFO=line(LC:S))) ;  (not(not(TEMPL=WAS)) -> INFO=file(S) ; fail)).
   65
   66% :-trace.
   67action_info_db(TEMPL,S,WAS) ==> if_missing(baseKB:action_info(TEMPL,_Help), baseKB:action_info(TEMPL,txtConcatFn(S,contains,WAS))).
   68% baseKB:action_info(TEMPL,txtConcatFn(S,contains,WAS)) <= action_info_db(TEMPL,S,WAS),{not_asserted(baseKB:action_info(TEMPL,_Help))}.
   69
   70
   71commands_list(ListS):- findall(Templ,get_all_templates(Templ),List),predsort(alpha_shorter_1,List,ListS).
   72
   73alpha_shorter(OrderO, P1,P2):-arg(1,P1,O1),arg(1,P2,O2),!,alpha_shorter_1(OrderO, O1,O2),!.
   74alpha_shorter(OrderO, P1,P2):-alpha_shorter_1(OrderO, P1,P2),!.
   75
   76alpha_shorter_1(OrderO, P1,P2):-functor_h(P1,F1,A1),functor_h(P2,F2,A2),compare(OrderF,F1,F2), 
   77 (OrderF \== '=' -> OrderO=OrderF ;
   78  (compare(OrderA,A1,A2), (OrderA \== '=' -> OrderO=OrderA ; compare(OrderO,P1,P2)))).
   79
   80
   81show_templ_doc(TEMPL):-findall(DOC,baseKB:action_info(TEMPL,DOC),DOCL),nvfmt(TEMPL=DOCL).
   82show_templ_doc_all(TEMPL):-findall(DOC,baseKB:action_info(TEMPL,DOC),DOCL),nvfmt(TEMPL=DOCL).
   83
   84nvfmt([XX]):-!,nvfmt(XX).
   85nvfmt(XX=[YY]):-!,nvfmt(XX=YY).
   86nvfmt(XX):-copy_term(XX,X),numbervars(X,0,_,[attvar(bind),singletons(true)]),fmt(X).
   87
   88% Help - A command to tell an agent all the possible commands
   89actHelp:- commands_list(ListS),forall(member(E,ListS),show_templ_doc(E)).
   90baseKB:agent_call_command(_Agent,actHelp) :- actHelp.
   91baseKB:agent_call_command(_Agent,actHelp(Str)) :-actHelp(Str).
   92
   93actHelp(Str):-commands_list(ListS),forall(member(E,ListS),write_doc_if_contains(Str,E)).
   94
   95write_doc_if_contains('',E):-!,show_templ_doc(E),!.
   96write_doc_if_contains([],E):-!,show_templ_doc(E),!.
   97write_doc_if_contains("",E):-!,show_templ_doc(E),!.
   98write_doc_if_contains(Must,E):-ignore((with_output_to(string(Str),show_templ_doc_all(E)),str_contains_all([Must],Str),fmt(Str))).
   99
  100
  101(vtActionTemplate(A),{nonvar(A),get_functor(A,Inst)} ==> isa(Inst,vtVerb)).
  102
  103impl_coerce_hook(Text,vtVerb,Inst):- isa(Inst,vtVerb),name_text(Inst,Text).
  104
  105%baseKB:agent_text_command(Agent,[Who],Agent,Cmd):- nonvar(Who), get_all_templates(Syntax),Syntax=..[Who,isOptional(_,Default)],Cmd=..[Who,Default].
  106%baseKB:agent_text_command(Agent,[Who,Type],Agent,Cmd):- get_all_templates(Syntax),nonvar(Who),Syntax=..[Who,isOptional(Type,_)],Cmd=..[Who,Type].
  107
  108:- include(prologmud(mud_footer)).  109
  110% :-ain((({get_all_templates(Templ)})==>vtActionTemplate(Templ))).
  111
  112:- kb_shared(baseKB:actParse/2).  113
  114(baseKB:type_action_info(_,TEMPL,Help) ==> baseKB:action_info(TEMPL,Help)).
  115
  116(baseKB:action_info(TEMPL,_Help) ==> vtActionTemplate(TEMPL)).
  117
  118vtActionTemplate(TEMPL), \+ baseKB:action_info(TEMPL,_)