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% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   24
   25reason2eng(cant(sense(Spatial, Sense, It, Why)), [ 'You can''t sense', It, ' ', ly(Sense), ly(Spatial), ' here', cuz(Why)]).
   26reason2eng(cant(reach(Spatial, It)), [  'You can''t reach ', It, ' ', ly(Spatial), '.']).
   27reason2eng(cant(manipulate(Spatial, self)), [ 'You can''t manipulate yourself like that', ly(Spatial), '.']).
   28reason2eng(alreadyhave(It), ['You already have the', It, '.']).
   29reason2eng(mustgetout(_It), ['You must get out/off it first.']).
   30reason2eng(self_relation(_Spatial, _It), ['Can\'t put thing inside itself!']).
   31reason2eng(moibeus_relation(Spatial, _, _), ['Topological error', ly(Spatial), '!']).
   32reason2eng(state(Spatial, Dark, t),        ['It''s too ', Dark, ' to ', ly(Sense), ly(Spatial), '!']):- problem_solution(Dark, Sense, _Light).
   33reason2eng(mustdrop(Spatial, It), [ 'You will have to drop', It, ' first', ly(Spatial), '.']).
   34reason2eng(cant(move(Spatial, _Thing)), ['Sorry, it\'s immobile', ly(Spatial), '.']).
   35reason2eng(cantdothat(EatCmd),    [ 'Sorry, you can\'t do: ', EatCmd, '.']).
   36reason2eng(R, R).
   37
   38% A percept or event:
   39%   - is a logical description of what happened
   40%   - includes English or other translations
   41%   - may be queued for zero, one, many, or all agents.
   42%   - may have a timestamp
   43% queue_percpt(Agent, [Logical, English|_], S0, S9).
   44%   where Logical is always first, and other versions are optional.
   45%   Logical should be a term, like sees(Thing).
   46%   English should be a list.
   47
   48% Inform notation
   49%   'c'        character)
   50%   "string"   string
   51%   "~"        quotation mark
   52%   "^"        newline
   53%   @          accent composition, variables 00 thru 31
   54%   \          line continuation
   55% Engish messages need to be printable from various perspectives:
   56%   person (1st/2nd/3rd), tense(past/present)
   57%   "You go south." / "Floyd wanders south."
   58%       {'$agent $go $1', ExitName }
   59%       { person(Agent), tense(go, Time), ExitName, period }
   60%       {'$p $t $w', Agent, go, ExitName}
   61%   "You take the lamp." / "Floyd greedily grabs the lamp."
   62%       Agent=floyd, {'%p quickly grab/T %n', Agent, grab, Thing }
   63%               else {'%p take/T %n', Agent, take, Thing }
   64%   %p  Substitute parameter as 1st/2nd/3rd person ("I"/"you"/"Floyd").
   65%         Implicit in who is viewing the message.
   66%         Pronouns: gender, reflexive, relative, nominative, demonstratve...?
   67%   %n  Substitute name/description of parameter ("the brass lamp").
   68%   /T  Modify previous word according to tense ("take"/"took").
   69%         Implicit in who is viewing the message?  Context when printed?
   70%   /N  Modify previous word according to number ("coin"/"coins").
   71%         What number?
   72%   %a  Article - A or An (indefinite) or The (definite) ?
   73%
   74%  I go/grab/eat/take
   75%  you go/grab/eat/take
   76%  she goes/grabs/eats/takes
   77%  floyd goes/grabs/eats/takes
   78%
   79%  eng(subject(Agent), 'quickly', verb(grab, grabs), the(Thing))
   80%  [s(Agent), 'quickly', v(grab, grabs), the(Thing)]
   81
   82capitalize([First|Rest], [Capped|Rest]) :-
   83  capitalize(First, Capped).
   84capitalize(Atom, Capitalized) :-
   85  atom(Atom), % [] is an atom
   86  downcase_atom(Atom, Lower),
   87  atom_chars(Lower, [First|Rest]),
   88  upcase_atom(First, Upper),
   89  atom_chars(Capitalized, [Upper|Rest]).
   90
   91context_agent(Agent, Context):-
   92  member(agent(Agent), Context).
   93context_agent(Agent, Context):-
   94  member(inst(Agent), Context).
   95% compile_eng(Context, Atom/Term/List, TextAtom).
   96%  Compile Eng terms to ensure subject/verb agreement:
   97%  If subject is agent, convert to 2nd person, else use 3rd person.
   98%  Context specifies agent, and (if found) subject of sentence.
   99
  100compile_eng(_Context, Done, '') :- Done == [], !.
  101compile_eng(Context, [First|Rest], [First2|Rest2]) :-
  102  compile_eng(Context, First, First2),
  103  compile_eng(Context, Rest, Rest2).
  104
  105compile_eng(Context, subj(Agent), Person) :-
  106  context_agent(Agent, Context),
  107  member(person(Person), Context).
  108compile_eng(Context, subj(Other), Compiled) :-
  109  compile_eng(Context, Other, Compiled).
  110compile_eng(Context, Agent, Person) :-
  111  context_agent(Agent, Context),
  112  member(person(Person), Context).
  113compile_eng(Context, person(Second, _Third), Compiled) :-
  114  member(subj(Agent), Context),
  115  context_agent(Agent, Context),
  116  compile_eng(Context, Second, Compiled).
  117compile_eng(Context, person(_Second, Third), Compiled) :-
  118  compile_eng(Context, Third, Compiled).
  119compile_eng(Context, tense(Verb, Tense), Compiled) :-
  120  verb_tensed(Context, Verb, Tense, Compiled).
  121compile_eng(Context, cap(Eng), Compiled) :-
  122  compile_eng(Context, Eng, Lowercase),
  123  capitalize(Lowercase, Compiled).
  124compile_eng(_Context, silent(_Eng), '').
  125
  126compile_eng(_Context, ly(spatial), '').
  127compile_eng(Context, ly(Word), Spatially) :-
  128  compile_eng(Context, Word, Spatial),
  129  atom(Spatial),
  130  atom_concat(Spatial, "ly", Spatially).
  131
  132compile_eng(Context, s(Word), Spatially) :- % TODO make actually plural
  133  compile_eng(Context, Word, Spatial),
  134  atom(Spatial),
  135  atom_concat(Spatial, "s", Spatially).
  136
  137compile_eng(Context, DetWord, AThing) :-
  138  compound(DetWord), DetWord=..[Det, Word],
  139  member(Det, [the, some, a, an]),
  140  compile_eng(Context, [Det, Word], AThing).
  141
  142
  143%compile_eng(_Context, Atom, Atom):- \+ atom(Atom), !.
  144compile_eng(Context, Inst, TheThing):- inst_of(Inst, Type, N), !,
  145   (nth0(N, [(unknown), the, thee, old, some, a], Det) -> true; atom_concat('#',N,Det)),
  146   compile_eng(Context, [Det, Type], TheThing).
  147compile_eng(_Context, Atom, Atom).
  148
  149verb_tensed(Context, Verb, past, Compiled):- 
  150  compile_eng(Context, Verb, Word),
  151  pasitfy_word(Word, Compiled).
  152verb_tensed(Context, Verb, _Tense, Compiled):- 
  153  compile_eng(Context, Verb, Compiled).
  154
  155
  156pasitfy_word(take,took).
  157pasitfy_word(make,made).
  158pasitfy_word(move,moved).
  159pasitfy_word(eat,ate).
  160pasitfy_word(eat,ate).
  161pasitfy_word(Verb,Compiled):- atomic_concat(Verb,'ed', Compiled).
  162
  163
  164nospace(_, ',').
  165nospace(_, ';').
  166nospace(_, ':').
  167nospace(_, '.').
  168nospace(_, '?').
  169nospace(_, '!').
  170nospace(_, '\'').
  171nospace('\'', _).
  172nospace(_, '"').
  173nospace('"', _).
  174nospace(_, Letter) :- char_type(Letter, space).
  175nospace(Letter, _) :- char_type(Letter, space).
  176
  177no_space_words('', _).
  178no_space_words(_, '').
  179no_space_words(W1, W2) :-
  180  atomic(W1),
  181  atomic(W2),
  182  atom_chars(W1, List),
  183  last(List, C1),
  184  atom_chars(W2, [C2|_]),
  185  nospace(C1, C2).
  186
  187insert_spaces([W], [W]).
  188insert_spaces([W1, W2|Tail1], [W1, W2|Tail2]) :-
  189  no_space_words(W1, W2),
  190  !,
  191  insert_spaces([W2|Tail1], [W2|Tail2]).
  192insert_spaces([W1, W2|Tail1], [W1, ' ', W3|Tail2]) :-
  193  insert_spaces([W2|Tail1], [W3|Tail2]).
  194insert_spaces([], []).
  195                    
  196make_atomic(Atom, Atom) :-
  197  atomic(Atom), !.
  198make_atomic(Term, Atom) :-
  199  term_to_atom(Term, Atom).
  200
  201eng2txt(Agent, Person, Eng, Text) :-  assertion(nonvar(Eng)),
  202  % Find subject, if any.
  203  findall(subj(Subject), findterm(subj(Subject), Eng), Context),
  204  % Compile recognized structures.
  205  maplist(compile_eng([agent(Agent), person(Person)|Context]), Eng, Compiled),
  206  % Flatten any sub-lists.
  207  flatten(Compiled, FlatList),
  208  % Convert terms to atom-strings.
  209  findall(Atom, (member(Term, FlatList), make_atomic(Term, Atom)), AtomList),
  210  findall(Atom2, (member(Atom2, AtomList), Atom2\=''), AtomList2),
  211  % Add spaces.
  212  bugout('insert_spaces(~w)~n', [AtomList2], printer),
  213  insert_spaces(AtomList2, SpacedList),
  214  % Return concatenated atoms.
  215  concat_atom(SpacedList, Text).
  216eng2txt(_Agent, _Person, Text, Text).
  217
  218%portray(ItemToPrint) :- print_item_list(ItemToPrint).  % called by print.
  219
  220list2eng([], ['<nothing>']).
  221list2eng([Single], [Single]).
  222list2eng([Last2, Last1], [Last2, 'and', Last1]).
  223list2eng([Item|Items], [Item, ', '|Tail]) :-
  224  list2eng(Items, Tail).
  225
  226prop2eng(_Obj, h(_Spatial, ExitDown, Object, Speaker), ['The', Object, 'has', Exit, Down, 'to', Speaker]):- ExitDown=..[Exit, Down].
  227prop2eng(_Obj, h(_Spatial, Held_by, Object, Speaker), ['The', Object, 'is', Held_by, Speaker]).
  228
  229prop2eng( Obj, EmittingLight, ['The', Obj, 'is glowing.']):- EmittingLight == emmiting(light), !.
  230prop2eng(_Obj, fragile(_), ['It looks fragile.']).
  231prop2eng(_Obj, shiny,  ['It\'s shiny!']).
  232prop2eng( Obj, effect(_, _), Out):- prop2eng(Obj, adjs(special), Out), !.
  233prop2eng(_Obj, desc(Out), Out):- !.
  234prop2eng(_Obj, can_do(Spatial, Eat, t), ['Able to', Eat , ly(Spatial), '.']).
  235prop2eng(_Obj, can_do(Spatial, Eat, f), ['Unable to', Eat , ly(Spatial), '.']).
  236
  237prop2eng(_Obj, can_be(Spatial, eat, t), ['It looks tasty ', ly(Spatial), '!']).
  238prop2eng(_Obj, can_be(Spatial, Eat, t), ['Can be', tense(Eat, past), ly(Spatial), '.']).
  239prop2eng(_Obj, can_be(Spatial, Eat, f), ['Can\'t be', tense(Eat, past), ly(Spatial), '.']).
  240
  241prop2eng(_Obj, state(Spatial, Open, t), ['It is', Open , ly(Spatial), '.']).
  242prop2eng(_Obj, state(Spatial, Open, f), ['It is not', Open , ly(Spatial), '.']).
  243prop2eng( Obj, inherit(Type, t), Out):-   prop2eng(Obj, adjs(Type), Out), !.
  244prop2eng( Obj, inherit(Type), Out):-   prop2eng(Obj, adjs(Type), Out), !.
  245prop2eng( Obj, inherited(Type), Out):- prop2eng(Obj, nouns(Type), Out), !.
  246prop2eng(_Obj, adjs(Type), [cap(Type), '.']).
  247prop2eng(_Obj, nouns(Type), [cap(Type), '.']).
  248prop2eng(_Obj, Prop, [cap(N), is, V, '.']):- Prop =..[N, V].
  249prop2eng(_Obj, _Prop,  []).
  250
  251prop2eng_txtl( Obj, Prop, UText1):- prop2eng(Obj, Prop, UText1), UText1 \==[], !.
  252prop2eng_txtl(_Obj, Prop, Text):- reason2eng(Prop, Text)-> Prop\==Text, !.
  253prop2eng_txtl(_Obj, Prop, [String]):- format(atom(String), ' {{ ~q. }}  ', [Prop]), !.
  254
  255
  256
  257proplist2eng(_Obj, [], []).
  258proplist2eng(Obj, [Prop|Tail], Text) :- !,
  259  proplist2eng(Obj, Tail, UText2) ->
  260  flatten([UText2], Text2),
  261  prop2eng_txtl(Obj, Prop, UText1) -> 
  262  flatten([UText1], Text1),
  263  append_if_new(Text1, Text2, Text), !.
  264proplist2eng(Obj, Prop, Text) :- prop2eng_txtl(Obj, Prop, Text), !.
  265
  266append_if_new1(Text1, Text2, Text):- flatten([Text1], TextF1), flatten([Text2], TextF2), append([_|TextF1], _, TextF2), !, Text=Text2.
  267
  268append_if_new(Text1, Text2, Text):- append_if_new1(Text1, Text2, Text), !.
  269append_if_new(Text2, Text1, Text):- append_if_new1(Text1, Text2, Text), !.
  270append_if_new(Text1, Text2, Text):- append(Text1, Text2, Text), !.
  271
  272%print_percept(Agent, sense(Sense, [you_are(Spatial, How, Here),
  273%                         exits_are(Exits),
  274%                         here_are(Nearby)...])) :-
  275%  findall(X, (member(X, Nearby), X\=Agent), OtherNearby),
  276%  player_format('You are ~p the ~p.  Exits are ~p.~nYou see: ~p.~n',
  277%         [How, Here, Exits, OtherNearby]).
  278
  279logical2eng(_Agent, [], []).
  280logical2eng(Agent, [Prop|Tail], Text) :- !,
  281  logical2eng(Agent, Tail, UText2) ->
  282  flatten([UText2], Text2),
  283  logical2eng(Agent, Prop, UText1) -> 
  284  flatten([UText1], Text1),
  285  append_if_new(Text1, Text2, Text), !.
  286
  287logical2eng(Agent, sense(_See, Sensing), SensedText) :- logical2eng(Agent, Sensing, SensedText).
  288
  289logical2eng(Agent, you_are(How, Here), [cap(subj(Agent)), person(are, is), How, 'the', Here, '.', '\n']).
  290logical2eng(Agent, you_are(_Spatial, How, Here), [cap(subj(Agent)), person(are, is), How, 'the', Here, '.', '\n']).
  291logical2eng(_Agent, exits_are(Exits), ['Exits are', ExitText, '.', '\n']):- list2eng(Exits, ExitText).
  292logical2eng(Agent, here_are(Nearby), [cap(subj(Agent)), person(see, sees), ':', SeeText, '.']):-
  293  findall(X, (member(X, Nearby), X\=Agent), OtherNearby),
  294  list2eng(OtherNearby, SeeText).
  295
  296logical2eng(Agent, carrying(Spatial, Items),
  297            [cap(subj(Agent)), person(are, is), ly(Spatial), 'carrying:'|Text]) :-
  298  list2eng(Items, Text).
  299
  300logical2eng(_Agent, notice_children(_See, _Parent, _How, []), []).
  301logical2eng(Agent, notice_children(Sense, Parent, How, List),
  302            [cap(How), 'the', Parent, subj(Agent), person(Sense, s(Sense)), ':'|Text]) :-
  303  list2eng(List, Text).
  304
  305logical2eng(_Agent, moved(Spatial, What, From, How, To),
  306            [cap(subj(What)), 'moves', ly(Spatial), ' from', From, 'to', How, To]).
  307
  308
  309logical2eng(_Agent, transformed(Before, After), [Before, 'turns into', After, .]).
  310
  311logical2eng(_Agent, destroyed(Thing), [Thing, 'is destroyed.']).
  312
  313logical2eng(Agent, sense_props(Sense, Object, PropList), 
  314            [cap(subj(Agent)), person(Sense, s(Sense)), Desc, '.'|PropDesc] ) :-
  315  select(name(Desc), PropList, SubPropList),
  316  proplist2eng(Object, SubPropList, PropDesc).
  317
  318logical2eng(Agent, sense_props(Sense, Object, PropList), 
  319            [cap(subj(Agent)), person(Sense, s(Sense)), 'a', Object, '.'|PropDesc] ) :-
  320  proplist2eng(Object, PropList, PropDesc).
  321
  322%logical2eng(_Agent, emote(_Spatial, say, Speaker, (*), Eng), [cap(subj(Speaker)), ': "', Text, '"']) :-  eng2txt(Speaker, 'I', Eng, Text).
  323logical2eng(_Agent, emoted(_Spatial, Says, Speaker, Audience, Eng),
  324    [cap(subj(Speaker)), s(Says), 'to', Audience, ', "', Text, '"']) :-
  325  eng2txt(Speaker, 'I', Eng, Text).
  326logical2eng(_Agent, emote(_Spatial, Says, Audience, Eng),
  327    [cap(subj(do)), s(Says), 'to', Audience, ', "', Text, '"']) :-
  328  eng2txt(me, 'I', Eng, Text).
  329
  330logical2eng(_Agent, time_passes, []).
  331% logical2eng(_Agent, time_passes, ['Time passes.']).
  332logical2eng(_Agent, failure(Action), ['Action failed:', Action]).
  333
  334logical2eng(Agent, PropList, [cap(subj(Agent)), person(see, sees), ':'|PropDesc] ) :-
  335  dmust(proplist2eng(something, PropList, PropDesc)), !.
  336
  337% logical2eng(_Agent, Logical, ['percept:', Logical]).
  338
  339
  340percept2txt(Agent, [_Logical, English], Text) :-
  341  eng2txt(Agent, you, English, Text).
  342percept2txt(Agent, [_Logical, English|More], Text) :-
  343  eng2txt(Agent, you, [English|More], Text).
  344percept2txt(Agent, [Logical|_], Text) :-
  345  logical2eng(Agent, Logical, Eng),
  346  eng2txt(Agent, you, Eng, Text).
  347
  348the(State, Object, Text) :-
  349  getprop(Object, name(D), State),
  350  atom_concat('the ', D, Text).
  351
  352an(State, Object, Text) :-
  353  getprop(Object, name(D), State),
  354  atom_concat('a ', D, Text).
  355
  356num(_Singular, Plural, [], Plural).
  357num(Singular, _Plural, [_One], Singular).
  358num(_Singular, Plural, [_One, _Two|_Or_More], Plural).
  359
  360expand_english(State, the(Object), Text) :-
  361  the(State, Object, Text).
  362expand_english(State, an(Object), Text) :-
  363  an(State, Object, Text).
  364expand_english(_State, num(Sing, Plur, List), Text) :-
  365  num(Sing, Plur, List, Text).
  366expand_english(_State, [], '').
  367expand_english(State, [Term|Tail], [NewTerm|NewTail]) :-
  368  expand_english(State, Term, NewTerm),
  369  expand_english(State, Tail, NewTail).
  370expand_english(_State, Term, Term)