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%  CODE FILE SECTION
   21:- nop(ensure_loaded('adv_main_states')).   22% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   23
   24
   25:- dynamic(undo/2).   26%undo([u, u, u, u, u, u, u, u]).
   27:- dynamic(advstate/1).   28advstate([]).
   29
   30
   31% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   32%  CODE FILE SECTION
   33:- nop(ensure_loaded('adv_state')).   34% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   35
   36% -----------------------------------------------------------------------------
   37% State may be implemented differently in the future (as a binary tree or
   38% hash table, etc.), but for now is a List.  These (backtrackable) predicates
   39% hide the implementation:
   40% assert/record/declare/memorize/think/associate/know/retain/affirm/avow/
   41%   insist/maintain/swear/posit/postulate/allege/assure/claim/proclaim
   42% retract/erase/forget/un-declare/unthink/repress/supress
   43% retrieve/remember/recall/ask/thought/think-of/reminisc/recognize/review/
   44%   recollect/remind/look(Spatial)-up/research/establish/testify/sustain/attest/certify/
   45%   verify/prove
   46% simulation: declare/undeclare/declared
   47% perception:
   48% memory: memorize/forget/thought
   49
   50% Like select, but always succeeds, for use in deleting.
   51select_always(Item, List, ListWithoutItem) :-
   52  select(Item, List, ListWithoutItem),
   53  !.
   54select_always(_Item, ListWithoutItem, ListWithoutItem).
   55
   56% Like select, but with a default value if not found in List..
   57%select_default(Item, _DefaultItem, List, ListWithoutItem) :-
   58%  select(Item, List, ListWithoutItem).
   59%select_default(DefaultItem, DefaultItem, ListWithoutItem, ListWithoutItem).
   60
   61% Manipulate simulation state
   62%declare(Fact, State):- player_local(Fact, Player), !, declare(wishes(Player, Fact), State).
   63declare((Fact1,Fact2), State, NewState) :- !,declare(Fact1, State, MidState),declare(Fact2, MidState, NewState).
   64declare(props(Object,Props), State, NewState) :- select(props(Object,OldProps), State, MidState),!,
   65  dmust((append(Props,OldProps,NewProps),!,declare(props(Object,NewProps), MidState, NewState))),!.
   66declare(Fact, State, NewState) :- notrace(((assertion(var(NewState)),dmust(append([Fact], State, NewState))))).
   67
   68%undeclare(Fact, State):- player_local(Fact, Player), !, undeclare(wishes(Player, Fact), State).
   69undeclare(Fact, State, NewState):- notrace(undeclare_(Fact, State, NewState)).
   70undeclare_(Fact, State, NewState) :- copy_term(State, Copy), select(Fact, State, NewState),
   71    assertion( \+ member(Copy , NewState)).
   72
   73%undeclare_always(Fact, State):- player_local(Fact, Player), !, undeclare_always(wishes(Player, Fact), State).
   74undeclare_always(Fact, State, NewState) :- select_always(Fact, State, NewState).
   75
   76%declared(Fact, State) :- player_local(Fact, Player), !, declared(wishes(Player, Fact), State).
   77declared(Fact, State) :- member(Fact, State).
   78
   79player_local(Fact, Player):- atom(Fact), is_declared_thread_player(Fact), !, current_player(Player).
   80
   81is_declared_thread_player(quit).
   82is_declared_thread_player(undo).
   83
   84
   85
   86% Entire state of simulation & agents is held in one list, so it can be easy
   87% to roll back.  The state of the simulation consists of:
   88%   object properties
   89%   object relations
   90%   percept queues for agents
   91%   memories for agents (actually logically distinct from the simulation)
   92% Note that the simulation does not maintain any history.
   93% TODO: change state into a term:
   94%   ss(Objects, Relationships, PerceptQueues, AgentMinds)
   95% TODO:
   96%   store initial state as clauses which are collected up and put into a list,
   97%     like the operators are, to provide proper prolog variable management.
   98must_input_state(S0):- notrace(assertion(is_list(S0);must_state(S0))).
   99must_output_state(S0):- notrace(assertion(must_state(S0);is_list(S0))),notrace(check4bugs(S0)).
  100must_state(S0):- is_list(S0), nb_setval(advstate,S0).
  101
  102get_objects(Spec, Set, State):- must_input_state(State), get_objects_(Spec, List, State, im(State)), !, list_to_set(List,Set).
  103%get_objects(_Spec, [player1, floyd], _State):-!.
  104
  105get_objects_(_Spec, [], [], im(_)) :- !.
  106get_objects_(Spec, OutList, [Store|StateList], im(S0)):-     
  107  (( stores_props(Store, Object, PropList) -> filter_spec(Spec, PropList))
  108    ->  OutList = [Object|MidList]
  109    ; OutList = MidList), !,
  110   get_objects_(Spec, MidList, StateList, im(S0)).
  111
  112stores_props(perceptq(Agent, PropList), Agent, PropList).
  113%stores_props(class_props(Agent, PropList), Agent, PropList).
  114stores_props(memories(Agent, PropList), Agent, PropList).
  115stores_props(props(Object, PropList), Object, PropList).
  116
  117% Retrieve Prop.
  118% NOPE getprop(Object, state(Spatial, Prop, Value), State):- atom(Prop), !, getprop1(Object, state(Spatial, Prop, Value), State).
  119% NOPE getprop(Object, Prop, State):- getprop1(Object, Prop, state(Spatial, State, f)), !, fail.
  120% MAYBE getprop(Object, Prop, State):- atom(Prop), getprop1(Object, state(Spatial, Prop, t), State).
  121% MAYBE getprop(Object, Prop, State):- atom(Prop), getprop1(Object, state(Spatial, Prop, f), State), !, fail.
  122
  123
  124get_all_props(Object, AllProps, S0):- findall(Prop,getprop(Object, Prop, S0),AllProps).
  125
  126getprop(Object, Prop, S0):-
  127  quietly((assertion(\+ atom(Prop)), getprop1(Object, Prop, S0)))
  128    *-> true; getprop2(Object, Prop, S0).
  129
  130getprop2(Object, Prop, Memory):- member(state(S0), Memory), !,
  131  getprop1(Object, Prop, S0).
  132
  133
  134getiprop(Object, Prop, S0) :-
  135  current_props(Object, PropList, S0),
  136  member(Prop, PropList).
  137
  138getprop1(Object, Prop, S0) :- getiprop(Object, Prop, S0).
  139getprop1(Object, Prop, S0) :- \+ member(object(Object,t), S0),
  140  current_props(Object, PropList, S0),  
  141  member(inherit(Delegate,t), PropList),
  142  \+ member(inherited(Delegate), PropList),
  143  getprop1(Delegate, Prop, S0).
  144
  145getprop_from_state(Object, Prop, Memory):-
  146  member(state(S0), Memory), !,
  147  getprop1(Object, Prop, S0).
  148
  149% current_props(Object, PropList, S0):- atom(Object),atom_
  150% current_props(Object, PropList, S0):- atom(Object),atom_
  151%current_props(Object, PropList, S0):- declared(props(Object, PropList), S0).
  152current_props(Object, PropList, S0):- 
  153  declared(props(Object, PropList), S0) 
  154    *-> true 
  155      ; declared(class_props(Object, PropList), S0).
  156
  157current_props_or(Object,PropList, Default, S0) :-
  158  declared(props(Object,PropList),S0)*->true; PropList=Default.
  159
  160% Replace or create Prop.
  161setprop(Object, Prop, S0, S2) :- notrace((setprop_(Object, Prop, S0, S2))).
  162
  163
  164setprop_(Object, Prop, S0, S2) :- 
  165  assertion(compound(Prop)),
  166
  167  current_props_or(Object, PropList, [], S0),
  168  undeclare_always(props(Object, _), S0, S1),
  169
  170  functor(Prop,F,A),
  171  duplicate_term(Prop,Old),
  172  nb_setarg(A,Old,_),
  173
  174  (select(Old, PropList, PropList2) ->
  175      (upmerge_prop(F,A,Old,Prop,Merged) ->
  176         ((Old==Merged,fail) -> S2=S0 ; 
  177           (append([Merged], PropList2, PropList3),declare(props(Object, PropList3), S1, S2)));
  178        append([Prop], PropList, PropList3),declare(props(Object, PropList3), S1, S2));
  179   (append([Prop], PropList, PropList3),declare(props(Object, PropList3), S1, S2))).
  180
  181
  182%     delprop_always(Object, Prop, S0U, S0a),
  183
  184/*setprop(Object, Prop, S0, S2) :-
  185  %dmust((
  186  %assertion(\+ atom(Prop)),
  187  undeclare(props(Object, PropList), S0, S1),
  188  select_always(Prop, PropList, PropList2),
  189  append([Prop], PropList2, PropList3),
  190  declare(props(Object, PropList3), S1, S2))
  191    ->true;
  192  declare(props(Object, [Prop]), S0, S2)).
  193*/
  194
  195upmerge_prop(_,_,Before,After,Result):- Before==After,!, Result=Before.
  196upmerge_prop(F,N,Before,After,Result):- arg(N,Before,B),arg(N,After,A),!,
  197  merge_value(F,N,B,A,R),duplicate_term(After,Result),nb_setarg(N,Result,R).
  198
  199merge_value(_,_,_,t,R):- !, R = t.
  200merge_value(_,_,_,f,R):- !, R = f.
  201merge_value(_,_,_,[],R):- !, R = [].
  202merge_value(_,_,_,A,R):- number(A),!,A=R.
  203
  204merge_value(_F,1,B,A,R):- B == A, !, R = A.
  205
  206merge_value(_F,1,B,A,R):- (is_list(B);is_list(A)),flatten([B,A],R).
  207
  208merge_value(_, 1,_,A,R):- number(A),!,A=R.
  209merge_value(_,1,_,_,_):- !,fail.
  210merge_value(_F,_,_B,A,R):- R = A.
  211
  212% Replace or create Prop.
  213updateprop(Object, Prop, S00, S2) :- notrace((updateprop_(Object, Prop, S00, S2))).
  214
  215updateprop_(Object, Prop, S0, S2) :-
  216  assertion(compound(Prop)),
  217
  218  current_props_or(Object, PropList, [], S0),
  219  undeclare_always(props(Object, _), S0, S1),
  220
  221  functor(Prop,F,A),
  222  duplicate_term(Prop,Old),
  223  nb_setarg(A,Old,_),
  224
  225  (select(Old, PropList, PropList2) ->
  226      (upmerge_prop(F,A,Old,Prop,Merged) ->
  227         ((Old==Merged,fail) -> S2=S0 ; % no update
  228           (append([Merged], PropList2, PropList3),declare(props(Object, PropList3), S1, S2)));
  229        append([Prop], PropList, PropList3),declare(props(Object, PropList3), S1, S2));
  230   (append([Prop], PropList, PropList3),declare(props(Object, PropList3), S1, S2))).
  231
  232
  233% Remove Prop.
  234delprop(Object, Prop, S0, S2) :-
  235  dmust((
  236  assertion(\+ atom(Prop)),
  237  undeclare(props(Object, PropList), S0, S1),
  238  select(Prop, PropList, NewPropList),
  239  declare(props(Object, NewPropList), S1, S2))).
  240
  241
  242delprop_always(Object, Prop, S0, S2) :-
  243  assertion(\+ atom(Prop)),
  244  undeclare(props(Object, PropList), S0, S1),
  245  select(Prop, PropList, NewPropList),
  246  declare(props(Object, NewPropList), S1, S2).
  247delprop_always(_Object, _Prop, S0, S0)