1/*
    2% NomicMUD: A MUD server written in Prolog
    3% Maintainer: Douglas Miles
    4% Dec 13, 2035
    5%
    6% Bits and pieces:
    7%
    8% LogicMOO, Inform7, FROLOG, Guncho, PrologMUD and Marty's Prolog Adventure Prototype
    9%
   10% Copyright (C) 2004 Marty White under the GNU GPL
   11% Sept 20, 1999 - Douglas Miles
   12% July 10, 1996 - John Eikenberry
   13%
   14% Logicmoo Project changes:
   15%
   16% Main file.
   17%
   18*/
   19
   20% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   21% CODE FILE SECTION
   22% :- ensure_loaded('adv_log2eng').
   23% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   24flag_level_compare(Flag,Prop):-flag(Flag,Was,Was),Prop=..[F|Args],apply(F,[Was|Args]).
   25
   26xtreme_english :- flag_level_compare(english,>(2)).
   27any_english :- \+ no_english.
   28no_english :- flag_level_compare(english,=(0)).
   29:- ignore(flag(english,0,1)).   30
   31pretty :- \+ flag_level_compare(pretty,=(0)).
   32:- ignore(flag(pretty,0,1)).   33
   34
   35same_agent(A,B):- A=@=B.
   36
   37% A percept or event:
   38% - is a logical description of what happened
   39% - includes English or other translations
   40% - may be queued for zero, one, many, or all agents.
   41% - may have a timestamp
   42% queue_percpt(Agent, [Logical, English|_], S0, S9).
   43% where Logical is always first, and other versions are optional.
   44% Logical should be a term, like sees(Thing).
   45% English should be a list.
   46
   47% Inform notation
   48% 'c'  character)
   49% "string" string
   50% "~"  quotation mark
   51% "^"  newline
   52% @   accent composition, variables 00 thru 31
   53% \   line continuation
   54% Engish messages need to be printable from various perspectives:
   55% person (1st/2nd/3rd), tense(past/present)
   56% "You go south." / "Floyd wanders south."
   57%  {'$agent $go $1', ExitName }
   58%  { person(Agent), tense(go, Time), ExitName, period }
   59%  {'$p $t $w', Agent, go, ExitName}
   60% "You take the lamp." / "Floyd greedily grabs the lamp."
   61%  Agent=floyd, {'%p quickly grab/T %n', Agent, grab, Thing }
   62%    else {'%p take/T %n', Agent, take, Thing }
   63% %p Substitute parameter as 1st/2nd/3rd person ("I"/"you"/"Floyd").
   64%   Implicit in who is viewing the message.
   65%   Pronouns: gender, reflexive, relative, nominative, demonstratve...?
   66% %n Substitute name/description of parameter ("the brass lamp").
   67% /T Modify previous word according to tense ("take"/"took").
   68%   Implicit in who is viewing the message? Context when printed?
   69% /N Modify previous word according to number ("coin"/"coins").
   70%   What number?
   71% %a Article - A or An (indefinite) or The (definite) ?
   72%
   73% I go/grab/eat/take
   74% you go/grab/eat/take
   75% she goes/grabs/eats/takes
   76% floyd goes/grabs/eats/takes
   77%
   78% eng(subject(Agent), 'quickly', verb(grab, grabs), the(Thing))
   79% [s(Agent), 'quickly', v(grab, grabs), the(Thing)]
   80
   81english_directve(quoted(_)).
   82english_directve(cap(_)).
   83english_directve(subj(_)).
   84english_directve(person(_,_)).
   85english_directve(tense(_,_)).
   86english_directve(a(_)).
   87english_directve(the(_)).
   88english_directve(num(_,_,_)).
   89english_directve(aux(_)).
   90english_directve(silent(_)).
   91english_directve(P):- english_suffix(S), functor(P,S,1).
   92
   93english_suffix(s).
   94english_suffix(es).
   95english_suffix(er).
   96english_suffix(ed).
   97english_suffix(ly).
   98english_suffix(ing).
   99
  100
  101capitalize([First|Rest], [Capped|Rest]) :- !,
  102 capitalize(First, Capped).
  103capitalize(Atom, Capitalized) :-
  104 atom(Atom), % [] is an atom
  105 downcase_atom(Atom, Lower),
  106 atom_chars(Lower, [First|Rest]),
  107 upcase_atom(First, Upper),
  108 atom_chars(Capitalized, [Upper|Rest]).
  109
  110context_agent(Agent, Context):- atom(Context),!,Context=Agent.
  111context_agent(Agent, Context):-
  112 declared(agent(Agent), Context), !.
  113context_agent(Agent, Context):-
  114 declared(inst(Agent), Context), !.
  115context_agent(Agent, Context):- \+ is_list(Context),
  116 action_doer(Context, Agent).
  117
  118
  119% compile_eng(Context, Atom/Term/List, TextAtom).
  120% Compile Eng terms to ensure subject/verb agreement:
  121% If subject is agent, convert to 2nd person, else use 3rd person.
  122% Context specifies agent, and (if found) subject of sentence.
  123
  124compile_eng(_Context, _Done, Text) :- assertion(var(Text)),fail.
  125compile_eng(_Context, Done, '') :- Done == [], !.
  126
  127compile_eng(Context, [cap(subj(Agent)), aux(be)|More], Person) :- !,
  128 compile_eng(Context, [cap(subj(Agent)), person(are, is)|More], Person) . 
  129
  130compile_eng(Context, [AN, Apple|More], Text) :- 
  131 (AN==a;AN==an),!,
  132 compile_eng_txt(Context, [Apple|More], TxtApple),
  133 name(TxtApple,[A|_]),
  134 char_type(A,to_lower(Vowel)), 
  135 (vowel(Vowel) -> atom_concat('an ', TxtApple,Text);atom_concat('a ', TxtApple,Text)).
  136% mu:compile_eng([agent('player~1'),person('player~1')],a(floyd),_64404)
  137compile_eng(Context, [First|Rest], [First2|Rest2]) :-
  138 compile_eng(Context, First, First2),
  139 compile_eng(Context, Rest, Rest2).
  140
  141compile_eng(_Context, aux(be), 'is') :- !.
  142compile_eng(Context, aux(Can), Text) :- !,compile_eng_txt(Context, Can, Text).
  143
  144compile_eng(Context, subj(Agent), Person) :-
  145 context_agent(Agent, Context),
  146 declared(person(Person), Context).
  147compile_eng(Context, subj(Other), Compiled) :-
  148 compile_eng(Context, Other, Compiled).
  149compile_eng(Context, Agent, Person) :-
  150 context_agent(Agent, Context),
  151 declared(person(Person), Context).
  152compile_eng(Context, person(Second, _Third), Compiled) :-
  153 declared(subj(Agent), Context),
  154 context_agent(Agent, Context),
  155 compile_eng(Context, Second, Compiled).
  156compile_eng(Context, person(_Second, Third), Compiled) :-
  157 compile_eng(Context, Third, Compiled).
  158compile_eng(Context, tense(Verb, Tense), Compiled) :-
  159 verb_tensed(Context, Verb, Tense, Compiled).
  160compile_eng(Context, cap(Eng), Compiled) :-
  161 compile_eng(Context, Eng, Lowercase),
  162 capitalize(Lowercase, Compiled).
  163compile_eng(_Context, silent(_Eng), '').
  164
  165%compile_eng(_Context, extra_verbose(_Eng), '...' ).
  166compile_eng(Context, extra_verbose(Eng), '...verbose...'(Compiled) ):- 
  167 compile_eng_txt(Context, Eng, Compiled).
  168
  169compile_eng(Context, Inst, TheThing):- atom(Inst), inst_of(Inst, Type, N), N\==0, !,
  170 (nth0(N, [(unknown), '', the, thee, old, some, a], Det) -> true; atom_concat('#',N,Det)),
  171 compile_eng(Context, [Det, Type], TheThing).
  172
  173compile_eng(Context, Atom, Text):- fail, atom(Atom), must_det(atomic_list_concat(ABC,' ',Atom)),
  174 ABC=[A,B|C],!,
  175 compile_eng_txt(Context, [A,B|C], Text).
  176
  177/*compile_eng(Context, String, Text):- string(String),
  178 name(Atom, String), compile_eng(Context, Atom, Text).
  179*/
  180compile_eng(_Context, Inst, Text):- \+ compound(Inst),!, format(atom(Text),'~w',[Inst]).
  181
  182compile_eng(Context, s(Word), Textually) :- % TODO make actually plural
  183 compile_eng_txt(Context, Word, Textual),
  184 atom(Textual),
  185 atom_concat("s", Textual, Textually).
  186compile_eng(Context, Wordly, Textually) :- functor(Wordly,S,1), english_suffix(S),
  187 Wordly =..[S, Word],
  188 compile_eng_txt(Context, Word, Textual),
  189 atom(Textual), add_suffix(Textual, S, Textually).
  190
  191compile_eng(Context, DetWord, AThing) :-
  192 compound(DetWord), DetWord=..[Det, Word],
  193 member(Det, [the, some, a, an, '']),
  194 compile_eng(Context, [Det, Word], AThing).
  195
  196/*compile_eng(Context, Prop, Text):- \+ atomic(Prop),
  197 log2eng(you,Prop,TextMid),!,
  198 compile_eng(Context,['\n'|TextMid],Text), !.
  199*/
  200compile_eng(_Context, Prop, Prop).
  201
  202vowel(a). vowel(e). vowel(i). vowel(o). vowel(u).
  203
  204verb_tensed(Context, Verb, past, Compiled):- 
  205 compile_eng_txt(Context, Verb, Word),
  206 pasitfy_word(Word, Compiled).
  207verb_tensed(Context, Verb, _Tense, Compiled):- 
  208 compile_eng_txt(Context, Verb, Compiled).
  209
  210add_suffix(Textual, es, Textually):- atom_concat(Textual, s, Textually). 
  211add_suffix(Textual, S, Textually):- atom_concat(Textual, S, Textually). 
  212
  213pasitfy_word(take,took).
  214pasitfy_word(make,made).
  215pasitfy_word(move,moved).
  216pasitfy_word(eat,ate).
  217pasitfy_word(Verb,Compiled):- \+ atom(Verb),!,Compiled=Verb.
  218pasitfy_word(Verb,Compiled):- atomic_concat(Verb,'ed', Compiled).
  219
  220
  221nospace(_, ',').
  222nospace(_, ';').
  223nospace(_, ':').              
  224nospace(_, '.').
  225nospace(_, '?').
  226nospace(_, '!').
  227nospace(_, '\'').
  228nospace('\'', _).
  229nospace(_, '"').
  230nospace('"', _).
  231nospace(_, Letter) :- char_type(Letter, space).
  232nospace(Letter, _) :- char_type(Letter, space).
  233
  234no_space_words('', _).
  235no_space_words(_, '').
  236no_space_words(W1, W2) :-
  237 atomic(W1),
  238 atomic(W2),
  239 atom_chars(W1, List),
  240 last(List, C1),
  241 atom_chars(W2, [C2|_]),
  242 nospace(C1, C2).
  243
  244insert_spaces([W], [W]).
  245insert_spaces([W1, W2|Tail1], [W1, W2|Tail2]) :-
  246 no_space_words(W1, W2),
  247 !,
  248 insert_spaces([W2|Tail1], [W2|Tail2]).
  249insert_spaces([W1, W2|Tail1], [W1, ' ', W3|Tail2]) :-
  250 insert_spaces([W2|Tail1], [W3|Tail2]).
  251insert_spaces([], []).
  252     
  253make_atomic(Atom, Atom) :-
  254 atomic(Atom), !.
  255make_atomic(Term, Atom) :-
  256 term_to_atom(Term, Atom).
  257
  258eng2txt(Agent, _Person, LogicalEnglish, Text) :- compound(LogicalEnglish), \+ is_list(LogicalEnglish),!,  
  259  percept2txt(Agent, LogicalEnglish, Text),!.
  260
  261eng2txt(Agent, Person, Eng, Text) :- assertion(nonvar(Eng)),
  262 % Find subject, if any.
  263 quietly((findall(subj(Subject), findterm(subj(Subject), Eng), Context),
  264 compile_eng_txt([agent(Agent), person(Person)|Context], Eng, Text))).
  265eng2txt(_Agent, _Person, Text, Text).
  266
  267compile_eng_txt(_Context, Done, '') :- Done == [], !.
  268compile_eng_txt(Context, [First], Text):- compile_eng_txt(Context, First, Text),!.
  269compile_eng_txt(Context, Eng, Text):- 
  270 flatten([Eng],FEng),
  271 compile_eng_txt_pt2(Context, FEng, FText), 
  272 format(atom(Text),'~w',FText).
  273
  274% Compile recognized structures.
  275compile_eng_txt_pt2(Context, EngIn, Text) :- 
  276 assertion(nonvar(EngIn)),
  277 flatten([EngIn], Eng),
  278 maplist(compile_eng(Context), Eng, Compiled),
  279 % Flatten any sub-lists.
  280 flatten([Compiled], FlatList),
  281 % Convert terms to atom-strings.
  282 findall(Atom, (member(Term, FlatList), make_atomic(Term, Atom)), AtomList),
  283 findall(Atom2, (member(Atom2, AtomList), Atom2\=''), AtomList1),
  284 grammar_check(Context,AtomList1,AtomList2),
  285 % Add spaces.
  286 bugout3('insert_spaces(~w)~n', [AtomList2], printer),
  287 insert_spaces(AtomList2, SpacedList),
  288 % Return concatenated atoms.
  289 concat_atom(SpacedList, Text).
  290
  291
  292grammar_check(_Context, [], []).
  293grammar_check(Context, [AN, Apple|More], Text) :- fail,
  294 (AN==a;AN==an),!,
  295 compile_eng_txt(Context, [Apple|More], TxtApple),
  296 name(TxtApple,[A|_]),
  297 char_type(A,to_lower(Vowel)), 
  298 (vowel(Vowel) -> atom_concat('an ', TxtApple,Text);atom_concat('a ', TxtApple,Text)).
  299
  300grammar_check(Context, [Word|More], [Word|MoreN]) :- 
  301 grammar_check(Context, More, MoreN).
  302
  303grammar_check(_Context, A, A).
  304
  305 
  306list2eng(Obj, Some, English):-
  307 list2eng([], Obj, Some, English).
  308
  309punct_or(Punct,Else,Value):- member(Else=Value,Punct)-> true ; Else=Value.
  310
  311list2eng(Punct,_Obj, [], [Nothing]):- punct_or(Punct,'<nothing>',Nothing).
  312list2eng(Punct, Obj, Some, English) :- \+ is_list(Some), !, 
  313 punct_or(Punct,log2eng,Log2Eng),
  314 call(Log2Eng, Obj, Some, English),!.
  315
  316:- nb_setval(list2eng, []).  317list2eng(_Punct, Obj, Some, [' ['| English]) :- nb_current(list2eng,D), number(D),!, list2eng_e(['.'=']','and'=','], Obj, Some, English), !.
  318list2eng(Punct, Obj, Some, English) :- nb_current(list2eng,D), b_setval(list2eng,1), list2eng_e(Punct, Obj, Some, English), !,
  319 b_setval(list2eng,D).
  320
  321
  322list2eng_e(Punct, Obj, [Single], English) :- !,
  323 punct_or(Punct,log2eng,Log2Eng),
  324 call(Log2Eng, Obj, Single, Named),
  325 punct_or(Punct,'.',PERIOD),
  326 flatten([Named, PERIOD], English).
  327
  328list2eng_e(Punct, Obj, [Last2, Last1], English) :- 
  329 punct_or(Punct,log2eng,Log2Eng),
  330 call(Log2Eng, Obj, Last2, Named2),
  331 list2eng(Obj, Last1, Named1),
  332 punct_or(Punct,'and',AND),
  333 punct_or(Punct,'.',PERIOD),
  334 flatten([Named2, AND, Named1, PERIOD], English).
  335
  336list2eng_e(Punct, Obj, [Some| More], English) :- 
  337 punct_or(Punct,log2eng,Log2Eng),
  338 call(Log2Eng, Obj, Some, Named),
  339 punct_or(Punct,',',COMMA),
  340 list2eng_e(Punct, Obj, More, MoreNamed),
  341 flatten([Named, COMMA, MoreNamed], English).
  342
  343list2eng_e(Punct, Obj, Some, English) :- 
  344 punct_or(Punct,log2eng,Log2Eng),
  345 call(Log2Eng, Obj, Some, English),!.
  346 
  347
  348log2eng( Obj, Some, English):- 
  349 log2eng_( Obj, Some, E),flatten([E],English).
  350
  351log2eng_( Obj, Prop, English):- 
  352 \+ ground(Prop), copy_term(Prop,Prop2),!,
  353 numbervars(Prop2,55,_), log2eng(Obj, Prop2, English).
  354log2eng_(_Obj, desc = (Out), [' "',Out,'"']):- !.
  355log2eng_(Obj, Some, English):- (pretty -> true ; dif(English,[])), logic2eng(Obj, Some, English),!.
  356log2eng_(Context, Inst, TheThing):- atom(Inst), inst_of(Inst, Type, N), !,
  357 (nth0(N, [(unknown), '', thee, old, some, a], Det) -> true; atom_concat('#',N,Det)),
  358 compile_eng_txt(Context, [Det, Type], TheThing).
  359log2eng_(_, V,[String]):- (string(V);(atom(V),atom_needs_quotes(V))),!, format(atom(String), ' "~w" ', [V]), !.
  360%log2eng_( Obj, Prop, [cap(N),of,O, aux(be), Value]):- Prop =..[N,O, V], list2eng(Obj, V, Value).
  361
  362log2eng_( Obj, Prop, [cap(N), aux(be), Value]):- Prop =..[N, V], list2eng(Obj, V, Value).
  363% log2eng_(Obj, Prop, English):- Prop =..[N, Obj1, A| VRange],Obj1==Obj,Prop2 =..[N, A| VRange], log2eng( Obj, Prop2, English).
  364%logic2eng(_Obj, Prop, [String]):- compound(Prop), !, String=''. % format(atom(String), ' \n {{ ~q. }}\n ', [Prop]), !.
  365log2eng_(_Obj, Prop, [String]):- compound(Prop), \+ xtreme_english, !, format(atom(String), ' {{ ~q }} ', [Prop]), !.
  366log2eng_( Obj, Prop, [cap(N), Value, aux(be), English]):- Prop =..[N, V| Range],
  367 log2eng(Obj, V, Value),
  368 maplist(logic2eng(Obj), Range, English).
  369log2eng_(_Obj, Prop, [String]):- format(atom(String), '~w', [Prop]), !.
  370
  371
  372timestamped_pred(holds_at).
  373
  374
  375%logic2eng(Obj, Var, [Text]):- var(Var),!, format(atom(Text),'{{~q}}',[log2eng(Obj, Var)]).
  376logic2eng( Obj, Prop, English):- 
  377 \+ ground(Prop), copy_term(Prop,Prop2),
  378 numbervars(Prop2,55,_),!,
  379 log2eng( Obj, Prop2, English).
  380logic2eng(_Obj, '$VAR'(Prop), English):- format(atom(English), ' ?VAR-~w', [Prop]), !.
  381logic2eng(_Obj, English, English):- english_directve(English),!.
  382logic2eng(_Obj, [English|Rest], [English|Rest]):- english_directve(English),!.
  383logic2eng(_Obj, [], []).
  384
  385logic2eng(Obj, [Prop|Tail], Text) :- !,
  386 must_det((log2eng(Obj, Tail, UText2) ->
  387 flatten([UText2], Text2),
  388 must_det(log2eng(Obj, Prop, UText1)) -> 
  389 flatten([UText1], Text1),
  390 append_if_new(Text1, Text2, Text))), !.
  391
  392
  393logic2eng(Obj, HWestFromTo_At, [ Ago | Info]):- 
  394  HWestFromTo_At =.. [H,West,From|To_At],
  395  timestamped_pred(H),
  396  append(To,[At],To_At), number(At),!,
  397  log2eng(Obj, ago(At), Ago),
  398  HWestFromTo =.. [H,West,From|To],
  399  logic2eng(Obj, HWestFromTo, Info).
  400
  401logic2eng(_Obj, Prop, [String]):- compound(Prop), no_english, !, format(atom(String), '~q', [Prop]), !.
  402logic2eng( Obj, ~(Type), ['(','logically','not','(',Out, '))']):- must_det(log2eng(Obj, Type, Out)), !.
  403
  404logic2eng(_Context, time_passes(Agent), ['Time passes for',Agent,'.']).
  405
  406logic2eng(_Context, percept(_Agent, How, _, _), ''):- How == know,!.
  407logic2eng(_Context, percept(Agent, see, Depth, props(Object,[shape=What])), extra_verbose(percept(Agent, see, Depth, props(Object,[shape=What])))).
  408
  409logic2eng(Context, percept(_Agent, _, _Depth, exit_list(Relation, Here, Exits)), ['Exits',Relation,Here,' are:', ExitText, '\n']):-  list2eng(Context, Exits, ExitText).
  410
  411logic2eng(_Context, percept(_Agent,  Sense, Depth, child_list(Object, Prep, '<mystery>'(Closed,_,_))), extra_verbose([Object, aux(be), Closed, from, ing(Sense), cap(Prep)]) ):- Depth \= depth(3).
  412logic2eng(_Context, percept(_Agent, _Sense, Depth, child_list(Object, Prep, [])), extra_verbose([nothing,Prep,Object]) ):- Depth \= 1.
  413logic2eng(Context,  percept( Agent, Sense, _Depth, child_list(Here, Prep, Nearby)), 
  414    [cap(subj(Agent)), is, Prep, Here, and, es(Sense), ':'  | SeeText]):- 
  415 select(Agent, Nearby, OthersNearby),!,  list2eng(Context, OthersNearby, SeeText).
  416
  417logic2eng(Context, percept( Agent, Sense, _Depth, child_list(Here, Prep, Nearby)), 
  418 [cap(subj(Agent)), person(Sense, es(Sense)),Prep,Here, ':', SeeText]):-  list2eng(Context, Nearby, SeeText).
  419                                 
  420logic2eng(Context, percept(Agent, How, Depth, Info), extra_verbose(notices(Agent,How,Depth,What))):-  Depth=1,
  421  logic2eng(Context, Info, What).
  422
  423
  424logic2eng(Context, percept(Agent, How, _, Info), notices(Agent,How, What)):- 
  425 \+ same_agent(Context, Agent), logic2eng(Agent, Info, What).
  426
  427
  428logic2eng(Context, carrying(Agent, Items),
  429   [cap(subj(Agent)), 'carrying:'|Text]) :-
  430 list2eng(Context, Items, Text).
  431                               
  432
  433logic2eng(_Agent, moved(_Doer, _Verb, What, From, Prep, To),
  434   [cap(subj(What)), 'moves', ' from', From, Prep, 'to', To]).
  435
  436
  437logic2eng(_Agent, transformed(Before, After), [Before, 'turns into', After, .]).
  438
  439logic2eng(_Agent, destroyed(Thing), [Thing, aux(be), 'destroyed.']).
  440
  441logic2eng(_Context, percept_props(_Agent, _Sense, _Object, _Depth, []),  [] ) :- !.
  442logic2eng(Context, percept_props(Agent, see, Object, _Depth, PropList), [cap(subj(Agent)), sees | English ] ) :-
  443 log2eng(Context, do_props(Object, PropList), English).
  444logic2eng(Context, percept_props(Agent, Sense, Object, _Depth, PropList), 
  445   [cap(subj(Agent)),
  446    person(Sense, es(Sense))| English] ) :-
  447 logic2eng(Context, do_props(Object, PropList), English ).
  448
  449logic2eng(Context, props(Object, PropList), [the(Object), ': ('|English] ) :-
  450  logic2eng(Context, do_props(Object, PropList), English ).
  451
  452logic2eng(_Agent, do_props(_Object, []),  '<..>' ) :- !.
  453logic2eng(_Agent, do_props(Object, PropList), English ) :- list2eng(['.'=')'],Object, PropList, English).
  454
  455
  456logic2eng(_Agent, memories(Object, PropList), ['\n\n', the(Object), ' remembers:\n'|English] ) :- 
  457 reverse(PropList,PropListR),
  458 list2eng([','=',\n',log2eng=percept2eng],Object, PropListR, English).
  459logic2eng(_Agent, perceptq(Object, PropList), ['\n\n', the(Object), ' notices:\n'|English] ) :- 
  460 list2eng([','=',\n'],Object, PropList, English).
  461
  462logic2eng(_Context, departing(Actor, In, Where, How, Dir), [Actor,was,In,Where,but,left,ing(How),Dir] ) :- !.
  463logic2eng(_Context, arriving(Actor, In, Where, How, Dir), [Actor,came,ing(How),Dir,In,Where] ) :- !.
  464
  465logic2eng(Context, did(Action), ['did happen: '|English] ) :- !, logic2eng(Context, Action, English ).
  466
  467logic2eng(Context, emoted(Speaker, EmoteType, Audience, Eng), ['happened: '|Rest]) :- !,
  468 logic2eng(Context, emote(Speaker, EmoteType, Audience, Eng), Rest).
  469
  470logic2eng(_, emote(Speaker, act, '*'(Place), Eng), [the(Speaker),at,Place,Text]) :- !,
  471 eng2txt(Speaker, Speaker, Eng, Text).
  472logic2eng(_, emote(Speaker, act, Audience, Eng), [Audience, notices, the(Speaker), Text]) :-
  473 eng2txt(Speaker, Speaker, Eng, Text).
  474logic2eng(_, emote(Speaker, EmoteType, Audience, Eng), [cap(subj(Speaker)), es(EmoteType), 'to', Audience, ', "', Text, '"']) :-
  475 eng2txt(Speaker, 'I', Eng, Text).
  476
  477logic2eng(_Agent, failure(Action), ['Action failed:', Action]).
  478
  479%logic2eng( Obj, effect(_, _), Out):- log2eng(Obj, adjs(special), Out), !.
  480
  481logic2eng(Obj, timestamp(Ord,Time), [timestamp,is,Ord,'(',Ago,')']):- log2eng(Obj, ago(Time), Ago).
  482
  483logic2eng(_Obj, ago(Time), [MinutesSecs,ago]):- 
  484 clock_time(Now),
  485 Dif is round((Now - Time)*10)/10,
  486 Minutes is round(Dif) // 60,
  487 USecs is round((Dif - (Minutes*60))*10)/10,
  488 Secs is round(USecs),
  489 (Minutes>0 -> 
  490 (Secs<10 
  491  -> format(atom(MinutesSecs),'~w:0~ws',[Minutes,Secs])
  492  ; format(atom(MinutesSecs),'~w:~ws',[Minutes,Secs]))
  493  ; format(atom(MinutesSecs),'~ws',[USecs])).
  494
  495
  496logic2eng(_Obj, h(exit(West), From , To), [To, 'is', West, 'of', From]):- !.
  497logic2eng(_Obj, h(ExitDown, Object, Speaker), [the(Object), 'has', Exit, Down, 'to', Speaker]):- 
  498 compound(ExitDown), 
  499 ExitDown=..[Exit, Down].
  500logic2eng(_Obj, h(Held_by , Object, Speaker), [the(Object), aux(be), Held_by, Speaker]).
  501
  502
  503logic2eng(_Obj, EmittingLight, [aux(be), 'glowing']):- EmittingLight == emmiting(light), !.
  504logic2eng(_Obj, breaks_into(_), ['looks breakable']).
  505logic2eng(_Obj, shiny, [aux(be), 'shiny!']).
  506
  507
  508
  509logic2eng( Obj, initial(Desc), ['initially described as'| Out]):- log2eng( Obj, Desc, Out).
  510logic2eng(_Obj, co(_), ['/**/ ']):- pretty,!.
  511logic2eng( Obj, co(Desc), ['(Created as: ', Out, ')']):- list2eng( Obj, Desc, Out).
  512
  513
  514%logic2eng(_Obj, adjs(Type), ['adjs:',Type]).
  515%logic2eng(_Obj, nouns(Type), ['nouns:',Type]).
  516
  517logic2eng(_Aobj, cant( sense(_Agent, Sense, It, Why)), [ 'can''t sense', It, ' ', ly(Sense), ' here', cuz(Why)]).
  518logic2eng(_Aobj, cant( reach(_Agent, It)), [ 'can''t reach ', It]).
  519logic2eng(_Aobj, cant( manipulate(self)), [ 'can''t manipulate yourself like that']).
  520logic2eng(_Aobj, alreadyhave(It), ['already have', the(It)]).
  521logic2eng(_Aobj, mustgetout(It), ['must get out/off ',It,' first.']).
  522logic2eng(_Aobj, self_relation(It), ['can\'t put ',It,' inside itself!']).
  523logic2eng(_Aobj, moibeus_relation( _, _), ['Topological error!']).
  524logic2eng(_Aobj, =(Dark, t),  ['It''s too ', Dark, ' to ', Sense, in, '!']):- problem_solution(Dark, Sense, _Light).
  525logic2eng(_Aobj, mustdrop(It), [ 'will have to drop', It, ' first.']).
  526logic2eng(_Aobj, cant( move(_Agent, It)), [It,aux(be),'immobile']).
  527logic2eng(_Aobj, cant( take(_Agent, It)), [It,aux(be),'untakeable']).
  528logic2eng(_Aobj, cantdothat(EatCmd), [ 'can\'t do: ', EatCmd]).
  529
  530%log2eng(_Obj, oper(OProp, [cap(N), aux(be), V]):- Prop =..[N, V].
  531
  532logic2eng( Obj, Prop, English):- Prop =..[N, V, T| VRange],T==t,Prop2 =..[N, V| VRange], log2eng( Obj, Prop2, English).
  533logic2eng(_Obj, has_rel(on), ['has a surface']).
  534logic2eng(_Obj, has_rel(in), ['has an interior']).
  535logic2eng(_Obj, has_rel(exit(_)), ['has exits']).
  536logic2eng(_Obj, can_be(eat), ['looks tasty ', '!']).
  537logic2eng(_Obj, can_be(take), ['can be taken!']).
  538logic2eng(_Obj, can_be(take,f), ['cannot be taken!']).
  539logic2eng(_Obj, can_be(Verb), ['Can', aux(be), tense(Verb, past)]).
  540logic2eng(_Obj, can_be(Verb, f), ['Can\'t', aux(be), tense(Verb, past)]).
  541logic2eng(_Obj, knows_verbs(Verb), ['Able to', Verb ]).
  542logic2eng(_Obj, knows_verbs(Verb, f), ['Unable to', Verb ]).
  543logic2eng(_Obj, =(cleanliness, clean), []) :- pretty.
  544logic2eng(_Obj, =(cleanliness, clean), [clean]).
  545logic2eng(_Obj, =(Name, Value), [Name,aux(be),Value]).
  546logic2eng(_Obj, =(Statused), [aux(be), Statused ]).
  547logic2eng(_Obj, =(Statused, f), [aux(be), 'not', Statused ]).
  548logic2eng( Obj, inherit(Type), ['is',Out]):- log2eng(Obj, [Type], Out), !.
  549logic2eng( Obj, isnt(Type, f), ['isnt '|Out]):- log2eng(Obj, [Type], Out), !.
  550logic2eng( Obj, inherited(Type), ['inherit',Out]):- log2eng(Obj, [Type], Out), !.
  551logic2eng( _Obj,msg(Msg), Msg):- !.
  552logic2eng(_Obj, class_desc(_), []).
  553logic2eng(_Obj, has_rel(Value,TF) , [TF,'that it has,',Value]).
  554
  555logic2eng( Obj, oper(Act,Precond,PostCond), OUT) :- 
  556 (xtreme_english->OUT = ['{{',if,'action: ',ActE,' test:', PrecondE,'resulting: ',PostCondE,'}}'];
  557 OUT = []),
  558 maplist(log2eng(Obj), [Act,Precond,PostCond], [ActE,PrecondE,PostCondE]).
  559
  560
  561% logic2eng( Obj, Prop, English):- Prop =..[N, Obj1, A| VRange],Obj1==Obj,Prop2 =..[N, A| VRange], log2eng( Obj, Prop2, English).
  562logic2eng( Obj, Prop, English):- Prop =..[N, V, T| VRange],T==t,Prop2 =..[N, V| VRange], log2eng( Obj, Prop2, English).
  563
  564logic2eng(Context, Inst, TheThing):- atom(Inst), inst_of(Inst, Type, N), !,
  565 (nth0(N, [(unknown), '', thee, old, some, a], Det) -> true; atom_concat('#',N,Det)),
  566 compile_eng(Context, [Det, Type], TheThing).
  567
  568logic2eng(_Obj, desc = (Out), [' "',Out,'"']):- !.
  569logic2eng(_, V,[String]):- (string(V);(atom(V),atom_needs_quotes(V))),!, format(atom(String), ' "~w" ', [V]), !.
  570
  571% logic2eng( Obj, Prop, [cap(N),of,O, aux(be), Value]):- Prop =..[N,O, V], list2eng(Obj, V, Value).
  572logic2eng( Obj, Prop, ['(',cap(N), ':', Value,')']):- Prop =..[N, V], list2eng(Obj, V, Value).
  573%logic2eng(_Obj, Prop, [String]):- compound(Prop), !, String=''. % format(atom(String), ' \n {{ ~q. }}\n ', [Prop]), !.
  574logic2eng(_Obj, Prop, [String]):- compound(Prop), \+ xtreme_english, !, format(atom(String), ' {{ ~q }} ', [Prop]), !.
  575logic2eng( Obj, Prop, [cap(N), Value, aux(be), English]):- Prop =..[N, V| Range],
  576 log2eng(Obj, V, Value),
  577 maplist(logic2eng(Obj), Range, English).
  578
  579logic2eng(_Obj, Prop, [String]):- format(atom(String), '~w', [Prop]), !.
  580
  581atom_needs_quotes(V):-format(atom(VV),'~q',[V]),V\==VV.
  582
  583append_if_new1(Text1, Text2, Text):- flatten([Text1], TextF1), flatten([Text2], TextF2), append([_|TextF1], _, TextF2), !, Text=Text2.
  584
  585append_if_new(Text1, Text2, Text):- append_if_new1(Text1, Text2, Text), !.
  586append_if_new(Text2, Text1, Text):- append_if_new1(Text1, Text2, Text), !.
  587append_if_new(Text1, Text2, Text):- append(Text1, Text2, Text), !.
  588
  589percept2eng(_Agent, [_Logical, English], English) :- !.
  590percept2eng(_Agent, [_Logical, English|More], [English|More]) :- !.
  591percept2eng(Context, [Logical|_], Eng) :- log2eng(Context, Logical, Eng),!.
  592percept2eng(Context, LogicalEnglish, Eng) :- log2eng(Context, LogicalEnglish, Eng).
  593
  594percept2txt(Agent, LogicalEnglish, Text) :-
  595 percept2eng(Agent, LogicalEnglish, English),
  596 eng2txt(Agent, Agent, English, Text).
  597
  598the(State, Object, Text) :-
  599 getprop(Object, name(D), State),
  600 compile_eng_txt(State, D, AD),
  601 atom_concat('the ', AD, Text).
  602
  603an(State, Object, Text) :-
  604 getprop(Object, name(D), State),
  605 compile_eng_txt(State, D, AD),
  606 atom_concat('a ', AD, Text).
  607
  608num(_Singular, Plural, [], Plural).
  609num(Singular, _Plural, [_One], Singular).
  610num(_Singular, Plural, [_One, _Two|_Or_More], Plural).
  611
  612expand_english(State, the(Object), Text) :-
  613 the(State, Object, Text).
  614expand_english(State, an(Object), Text) :-
  615 an(State, Object, Text).
  616expand_english(_State, num(Sing, Plur, List), Text) :-
  617 num(Sing, Plur, List, Text).
  618expand_english(_State, [], '').
  619expand_english(State, [Term|Tail], [NewTerm|NewTail]) :-
  620 expand_english(State, Term, NewTerm),
  621 expand_english(State, Tail, NewTail).
  622expand_english(_State, Term, Term).
  623
  624
  625% %%%%%%%%%%%%%%%
  626% Our user:portray(Logic) English helpers
  627% %%%%%%%%%%%%%%%
  628
  629player_pprint(Doer, Logic, always):- xtreme_english,!, print_english(Doer, Logic).
  630player_pprint(_Doer, D,K):- pprint(D,K).
  631
  632print_english(Doer, Logic):- is_list(Logic),!, maplist(print_english(Doer), Logic).
  633
  634print_english(Doer, Logic):- log2eng(Doer, Logic, Eng),must_det((eng2txt(Doer, Doer, Eng, Text))), pprint(Text,always).
  635
  636
  637maybe_our_portray_english(Logic):- 
  638 compound(Logic), 
  639 our_current_portray_level(Level), 
  640 Level > 0,
  641 Level < 2, 
  642 \+ is_list(Logic),
  643 flag_level_compare(english,>(1)),
  644 our_portray_english_simple_only(Logic),!.
  645
  646our_portray_english(Logic):-  
  647 english_codes(Logic,Codes),
  648 format('{|i7|| ~s |}',[Codes]).
  649
  650our_portray_english_simple_only(Logic):-  
  651 english_codes(Logic,Codes),
  652 was_simple_english_line(Codes),
  653 format('{|i7|| ~s |}',[Codes]).
  654
  655english_codes(Logic,Codes):- 
  656 once(Agent = self ; current_agent(Agent)),
  657 with_output_to(codes(SCodes),print_english(Agent, Logic)),!,
  658 trim_eols(SCodes,Codes),!.
  659
  660trim_eols(String,Codes):- append(LString,[N],String),(N==13;N==10),!,trim_eols(LString,Codes).
  661trim_eols(Codes,Codes).
  662
  663was_simple_english_line(String):- last(String,N),member(N,`.,]`),!,fail.
  664was_simple_english_line(String):-
  665 freeze(C, member(C,`\n\r[{?`)),
  666 \+ member(C,String).
  667
  668:- dynamic user:portray/1.  669:- multifile user:portray/1.  670:- module_transparent user:portray/1.  671user:portray(Logic) :-
  672 maybe_our_portray_english(Logic)