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:- multifile(extra_decl/2).   26:- dynamic(extra_decl/2).   27:- dynamic(undo/2).   28%undo([u, u, u, u, u, u, u, u]).
   29:- dynamic(advstate_db/1).   30advstate_db([]).
   31
   32
   33get_advstate_varname(Varname):- nb_current(advstate_var,Varname),Varname\==[],!.
   34get_advstate_varname(advstate).
   35get_advstate(State):- get_advstate_varname(Var),nb_current(Var,State).
   36set_advstate(State):- get_advstate_varname(Var),nb_setval(Var,State).
   37declared_advstate(Fact):- get_advstate(State),declared(Fact,State).
   38
   39% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   40% CODE FILE SECTION
   41:- nop(ensure_loaded('adv_state')).   42% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   43
   44% -----------------------------------------------------------------------------
   45% State may be implemented differently in the future (as a binary tree or
   46% hash table, etc.), but for now is a List. These (backtrackable) predicates
   47% hide the implementation:
   48% assert/record/declare/memorize/think/associate/know/retain/affirm/avow/
   49% insist/maintain/swear/posit/postulate/allege/assure/claim/proclaim
   50% retract/erase/forget/un-declare/unthink/repress/supress
   51% retrieve/remember/recall/ask/thought/think-of/reminisc/recognize/review/
   52% recollect/remind/look-up/research/establish/testify/sustain/attest/certify/
   53% verify/prove
   54% simulation: declare/undeclare/declared
   55% perception:
   56% memory: memorize/forget/thought
   57
   58% Like select, but always succeeds, for use in deleting.
   59select_always(Item, List, ListWithoutItem) :- select(Item, List, ListWithoutItem) -> true; ListWithoutItem=List.
   60 
   61% Like select, but with a default value if not found in List..
   62%select_default(Item, _DefaultItem, List, ListWithoutItem) :-
   63% select(Item, List, ListWithoutItem).
   64%select_default(DefaultItem, DefaultItem, ListWithoutItem, ListWithoutItem).
   65
   66% Manipulate simulation state
   67%declare(Fact, State):- player_local(Fact, Player), !, declare(wishes(Player, Fact), State).
   68:- export(declare/3).   69:- defn_state_setter(declare(fact)).   70declare(Fact, State, NewState) :- notrace((assertion(var(NewState)),is_list(State))),!,notrace(declare_list(Fact,State,NewState)).
   71declare(Fact, inst(Object), inst(Object)):- !,
   72   get_advstate(State), 
   73   (declared(props(Object, PropList),State);PropList=[]),!, 
   74   declare_list(Fact,PropList,NewPropList),
   75   select_always(props(Object,_),State,MidState),
   76   append([props(Object,NewPropList)], MidState, NewState),
   77   set_advstate(NewState).
   78declare(Fact, type(Type), type(Type)):- !,
   79   get_advstate(State), 
   80   (declared(type_props(Type, PropList),State);PropList=[]),!, 
   81   declare_list(Fact,PropList,NewPropList),
   82   select_always(type_props(Type,_),State,MidState),
   83   append([type_props(Type,NewPropList)], MidState, NewState),
   84   set_advstate(NewState).
   85declare(Fact, Pred1Name, Pred1Name):- is_pred1_state(Pred1Name),DBPred=..[Pred1Name,State], (retract(DBPred);State=[]),!, declare_list(Fact, State, NewState),DBPredNewState=..[Pred1Name,NewState], asserta(DBPredNewState).
   86declare(Fact, VarName, VarName):- atom(VarName),nb_current(VarName,PropList), declare_list(Fact,PropList,NewPropList),b_setval(VarName,NewPropList).
   87declare(Fact, Object, Object):- callable(Fact),!, Fact=..[F|List], 
   88  Call=..[F, NewArg|List], 
   89  current_predicate(_,Call),!, 
   90  ignore( \+ \+ retract(Call)),
   91  NewArg=Object,
   92  asserta(Call).
   93
   94is_pred1_state(istate).
   95is_pred1_state(statest).
   96is_pred1_state(advstate_db).
   97
   98declare_list(Fact, State, NewState) :- assertion(compound(Fact)),assertion(var(NewState)), Fact==[], !, NewState = State.
   99declare_list((Fact1,Fact2), State, NewState) :- !,declare_list(Fact1, State, MidState),declare_list(Fact2, MidState, NewState).
  100declare_list([Fact1|Fact2], State, NewState) :- !,declare_list(Fact1, State, MidState),declare_list(Fact2, MidState, NewState).
  101declare_list(HasList, State, [NewFront|NewState]) :- 
  102  functor(HasList,F,A), arg(A,HasList,PropList),is_list(PropList),
  103  functor(Functor,F,A), \+ \+ type_functor(state,Functor),
  104  arg(1,HasList,Object), arg(1,Functor,Object),
  105  select(Functor,State,NewState),!,
  106  arg(A,Functor,OldPropList),assertion(is_list(OldPropList)),
  107  append(PropList,OldPropList,NewPropList),
  108  assertion(A=2;A=3), NewFront=..[F,Object,NewPropList]. 
  109declare_list(Fact, State, NewState) :- append([Fact],State,NewState).
  110
  111
  112
  113
  114
  115%undeclare(Fact, State):- player_local(Fact, Player), !, undeclare(wishes(Player, Fact), State).
  116undeclare(Fact, State, NewState):- notrace(undeclare_(Fact, State, NewState)).
  117undeclare_(Fact, State, NewState) :- copy_term(State, Copy), select(Fact, State, NewState),
  118 assertion( \+ member(Copy , NewState)).
  119
  120%undeclare_always(Fact, State):- player_local(Fact, Player), !, undeclare_always(wishes(Player, Fact), State).
  121undeclare_always(Fact, State, NewState) :- select_always(Fact, State, NewState).
  122
  123%declared(Fact, State) :- player_local(Fact, Player), !, declared(wishes(Player, Fact), State).
  124
  125:- export(declared/2).  126:- defn_state_getter(declared(fact)).  127declared(Fact, State) :-
  128  quietly(( is_list(State)->declared_list(Fact, State);declared_link(declared,Fact, State))).
  129
  130declared_list(Fact, State) :- member(Fact, State).
  131declared_list(Fact, State) :- member(link(VarName), State), declared_link(declared, Fact, VarName).
  132declared_list(Fact, State) :- member(inst(Object), State), declared_link(declared, Fact, Object).
  133
  134:- meta_predicate(declared_link(2,?,*)).  135declared_link(Pred2, Fact, VarName):- strip_module(Pred2,_,Var), var(Var), !, declared_link(declared, Fact, VarName).
  136declared_link(Pred2, Fact, VarName):- atom(VarName), nb_current(VarName,PropList), call(Pred2, Fact, PropList).
  137declared_link(Pred2, Fact, inst(Type)):- declared_advstate(props(Type,PropList)), call(Pred2, Fact, PropList).
  138declared_link(Pred2, Fact, type(Type)):- declared_advstate(type_props(Type,PropList)), call(Pred2, Fact, PropList).
  139declared_link(Pred2, Fact, Object):- nonvar(Object), extra_decl(Object, PropList), call(Pred2, Fact, PropList).
  140declared_link(Pred2, Fact, Object):- get_advstate(State), direct_props(Object,PropList,State), call(Pred2, Fact, PropList).
  141declared_link(declared, Fact, Object):- callable(Fact), Fact=..[F|List], Call=..[F, Object|List], current_predicate(_,Call),!,call(Call).
  142declared_link(Pred2, Fact, Object):- var(Object), get_advstate(State),member(Prop, State),arg(1, Prop, Object), arg(2,Prop,PropList),
  143  call(Pred2, Fact, PropList).
  144  
  145
  146
  147% extra_decl(Object, PropList):- get_advstate(State), direct_props(Object,PropList,State).
  148
  149% Entire state of simulation & agents is held in one list, so it can be easy
  150% to roll back. The state of the simulation consists of:
  151% object properties
  152% object relations
  153% percept queues for agents
  154% memories for agents (actually logically distinct from the simulation)
  155% Note that the simulation does not maintain any history.
  156% TODO: change state into a term:
  157% ss(Objects, Relationships, PerceptQueues, AgentMinds)
  158% TODO:
  159% store initial state as clauses which are collected up and put into a list,
  160% like the operators are, to provide proper prolog variable management.
  161
  162get_objects(Spec, Set, State):- 
  163 quietly((must_input_state(State), 
  164  get_objects_(Spec, List, State, im(State)), !, 
  165  list_to_set(List,Set))).
  166%get_objects(_Spec, [player1, floyd], _State):-!.
  167
  168get_objects_(_Spec, [], [], im(_)) :- !.
  169get_objects_(Spec, OutList, [Store|StateList], im(S0)):- 
  170 (( stores_props(Store, Object, PropList) -> filter_spec(Spec, PropList))
  171 -> OutList = [Object|MidList]
  172 ; OutList = MidList), !,
  173 get_objects_(Spec, MidList, StateList, im(S0)).
  174
  175stores_props(perceptq(Agent, PropList), Agent, PropList).
  176%stores_props(type_props(Agent, PropList), Agent, PropList).
  177stores_props(memories(Agent, PropList), Agent, PropList).
  178stores_props(props(Object, PropList), Object, PropList).
  179
  180
  181
  182
  183as_first_arg(Object, Prop, Element):-
  184  callable(Prop), Prop=..[Name| Value], Element =..[Name, Object| Value].
  185
  186
  187% get_all_props(Object, AllProps, S0):- findall(Prop,getprop(Object, Prop, S0),AllProps).
  188:- defn_state_getter(getprop(thing, nv)).  189getprop(Object, Prop, S0) :- quietly((correct_prop(Prop,PropList),getprop0(Object, PropList, S0))).
  190
  191getprop0(Object, Prop, S0):-  
  192  ((as_first_arg(Object, Prop, Element), declared(Element,S0)) 
  193     *-> true ; getprop1(Object, [], Object, Prop, S0)).
  194
  195getprop1(Orig, AlreadyUsed, Object, Prop, S0) :- 
  196 direct_props(Object, PropList, S0),
  197 ( declared(Prop, PropList)*-> true ; 
  198 inherited_prop1(Orig, AlreadyUsed, Object, Prop, PropList, S0)).
  199
  200inherited_prop1(Orig, AlreadyUsed, _Object, Prop, PropList, S0):- 
  201 member(inherit(Delegate,t), PropList),
  202 \+ member(inherit(Delegate, t), AlreadyUsed),
  203 \+ member(inherit(Delegate, f), PropList),
  204 \+ member(inherited(Delegate), AlreadyUsed),
  205 append(AlreadyUsed, PropList, AllPropList),
  206 \+ member(isnt(Delegate), AllPropList),
  207 getprop1(Orig, AllPropList, Delegate, Prop, S0).
  208
  209inherited_prop1(_Orig, AlreadyUsed, _Object, Prop, PropList, _S0):- 
  210 member(link(Delegate), PropList),
  211 \+ member(link(Delegate), AlreadyUsed),
  212 nb_current(Delegate,NewProps),
  213 member(Prop,NewProps).
  214
  215
  216direct_props(Object, PropList, State):- 
  217 (var(State)->get_advstate(State); true),
  218 (declared(props(Object, PropList), State) 
  219 *-> true 
  220 ; ( declared(type_props(Object, PropList), State) 
  221 *-> true 
  222  ; extra_decl(Object, PropList))).
  223
  224direct_props_or(Object,PropList, Default, S0) :-
  225 direct_props(Object, PropList, S0)*->true; PropList=Default.
  226
  227object_props_or(Object,PropList, Default, S0) :-
  228 declared(props(Object,PropList),S0)*->true; PropList=Default.
  229
  230 :- meta_predicate each_prop(3,?,?,?).  231each_prop(_, [], S0, S0) :-!.
  232each_prop(Pred, [Prop|List], S0, S2) :- !,
  233  each_prop(Pred, Prop, S0, S1),
  234  each_prop(Pred, List, S1, S2).
  235each_prop(Pred, Prop, S0, S1):- assertion(compound(Prop)), call(Pred, Prop, S0, S1),!.
  236
  237
  238% Remove Prop.
  239:- defn_state_setter(delprop(thing, nv)).  240delprop(Object, Prop, S0, S2) :- notrace(must_det((correct_props(Object,Prop,PropList), each_prop(delprop_(Object), PropList, S0, S2)))).
  241delprop_(Object, Prop, S0, S2) :- 
  242 undeclare(props(Object, PropList), S0, S1),
  243 select(Prop, PropList, NewPropList),
  244 declare(props(Object, NewPropList), S1, S2).
  245
  246% Remove Prop Always.
  247:- defn_state_setter(delprop_always(thing, nv)).  248delprop_always(Object, Prop, S0, S2) :- notrace(must_det((correct_props(Object,Prop,PropList), each_prop(delprop_always_(Object), PropList, S0, S2)))).
  249delprop_always_(Object, Prop, S0, S2) :-  delprop_(Object, Prop, S0, S2), !.
  250delprop_always_(_Object, _Prop, S0, S0).
  251
  252% Replace or create Prop.
  253:- defn_state_setter(setprop(thing, nv)).  254setprop(Object, Prop, S0, S2) :- notrace((correct_props(Object,Prop,PropList), each_prop(setprop_(Object), PropList, S0, S2))).
  255
  256setprop_(Object, Prop, S0, S2) :-  
  257 direct_props_or(Object, PropList, [], S0),
  258 undeclare_always(props(Object, _), S0, S1),
  259 functor(Prop,F,A),
  260 duplicate_term(Prop,Old),
  261 nb_setarg(A,Old,_),
  262 (select(Old, PropList, PropList2) ->
  263 (upmerge_prop(F,A,Old,Prop,Merged) ->
  264  ((Old==Merged,fail) -> S2=S0 ; 
  265  (append([Merged], PropList2, PropList3),declare(props(Object, PropList3), S1, S2)));
  266 append([Prop], PropList, PropList3),declare(props(Object, PropList3), S1, S2));
  267 (append([Prop], PropList, PropList3),declare(props(Object, PropList3), S1, S2))).
  268
  269% Update or create Prop.
  270:- defn_state_setter(updateprop(thing, nv)).  271updateprop(Object, Prop, S0, S2) :- notrace((correct_props(Object,Prop,PropList), each_prop(updateprop_(Object), PropList, S0, S2))).
  272
  273updateprop_(Object, Prop, S0, S2) :- 
  274 assertion(compound(Prop)),
  275 direct_props_or(Object, PropList, [], S0),
  276 (member(Prop,PropList)
  277 -> S0=S2;
  278 (undeclare_always(props(Object, _), S0, S1),
  279 updateprop_1(Object, Prop, PropList, S1, S2))).
  280
  281updateprop_1(Object, Prop, PropList, S0, S2) :-
  282 functor(Prop,F,A),
  283 duplicate_term(Prop,Old),
  284 nb_setarg(A,Old,_),
  285
  286 (select(Old, PropList, PropList2) ->
  287 (upmerge_prop(F,A,Old,Prop,Merged) ->
  288  ((Old==Merged,fail) -> declare(props(Object, PropList), S0, S2) ; % no update
  289  (append([Merged], PropList2, PropList3),declare(props(Object, PropList3), S0, S2)));
  290 append([Prop], PropList, PropList3),declare(props(Object, PropList3), S0, S2));
  291 (append([Prop], PropList, PropList3),declare(props(Object, PropList3), S0, S2))).
  292
  293      
  294/*
  295
  296setprop(Object, Prop, S0, S2) :-
  297 %must_det((
  298 %assertion(\+ atom(Prop)),
  299 undeclare(props(Object, PropList), S0, S1),
  300 select_always(Prop, PropList, PropList2),
  301 append([Prop], PropList2, PropList3),
  302 declare(props(Object, PropList3), S1, S2))
  303 ->true;
  304 declare(props(Object, [Prop]), S0, S2)).
  305*/
  306
  307upmerge_prop(_,_,Before,After,Result):- Before==After,!, Result=Before.
  308upmerge_prop(F,N,Before,After,Result):- arg(N,Before,B),arg(N,After,A),!,
  309 merge_value(F,N,B,A,R),duplicate_term(After,Result),nb_setarg(N,Result,R).
  310
  311merge_value(F,N,B,A,RO):- text_prop(F), \+ is_list(B),!,merge_value(F,N,[B],A,RO).
  312merge_value(F,N,B,A,RO):- text_prop(F), \+ is_list(A),!,merge_value(F,N,B,[A],RO).
  313merge_value(F,_,_,A,R):- single_valued_prop(F),!,A=R.
  314
  315merge_value(=,2,_,V,R):- !, R = V.
  316
  317merge_value(_,_,_,t,R):- !, R = t.
  318merge_value(_,_,_,f,R):- !, R = f.
  319merge_value(_,_,_,[],R):- !, R = [].
  320merge_value(_,_,_,A,R):- number(A),!,A=R.
  321
  322merge_value(_F,1,B,A,R):- B == A, !, R = A.
  323
  324merge_value(_F,1,B,A,RO):- (is_list(B);is_list(A)),flatten([A,B],R),!,list_to_set(R,RO).
  325
  326merge_value(_, 1,_,A,R):- number(A),!,A=R.
  327merge_value(_,1,_,_,_):- !,fail.
  328merge_value(_F,_,_B,A,R):- R = A.
  329
  330text_prop(nouns).
  331text_prop(adjs).
  332text_prop(desc).
  333
  334single_valued_prop(name).
  335single_valued_prop(desc).
  336single_valued_prop(mass).
  337single_valued_prop(volume).
  338
  339
  340is_state_info(StateInfo):- \+ compound(StateInfo), !, fail.
  341is_state_info(StateInfo):- functor(StateInfo, F, A),
  342   (functor_arity_state(F, A)->true; (A>2, functor_arity_state(F, 2))).
  343
  344functor_arity_state(F, A):- functor(TypeFunctor, F, A), type_functor(state, TypeFunctor).
  345functor_arity_state(type, 2).
  346%functor_arity_state(F, A):- is_spatial_rel(F).
  347
  348is_spatial_rel(worn_by).
  349is_spatial_rel(held_by).
  350is_spatial_rel(in).
  351is_spatial_rel(on).
  352is_spatial_rel(exit).
  353
  354push_to_state(StateInfo):- \+ compound(StateInfo), !.
  355push_to_state(StateInfo):- is_list(StateInfo), !, maplist(push_to_state, StateInfo).
  356push_to_state(type(Type, Conj)):-  !, push_to_state(props(type(Type), Conj)).
  357push_to_state(props(type(Type), Conj)):- !, props_to_list(Conj, List), push_to_state(type_props(Type, List)).
  358push_to_state(props(Obj, Conj)):-  props_to_list(Conj, List) -> Conj\== List, !, push_to_state(props(Obj, List)).
  359push_to_state(type_props(Obj, Conj)):-  props_to_list(Conj, List) -> Conj\== List, !, push_to_state(type_props(Obj, List)).
  360push_to_state(StateInfo):- StateInfo=..[F, Obj, E1, E2|More], functor_arity_state(F, 2), !, StateInfoNew=..[F, Obj, [E1, E2|More]], !, push_to_state(StateInfoNew).
  361push_to_state(StateInfo):- props_to_list(StateInfo, StateInfo2)->StateInfo2\=[StateInfo], !, push_to_state(StateInfo2).
  362push_to_state(StateInfo):- is_state_info(StateInfo), !, declare(StateInfo, istate, _).
  363push_to_state(StateInfo):- forall(arg(_, StateInfo, Sub), push_to_state(Sub)).
  364
  365correct_props(_Obj, PropsIn, PropsOut):- props_to_list(PropsIn, PropsOut), !.
  366
  367check_atom(Atom):- assertion(atom(Atom)).
  368
  369props_to_list(Nil, []):- assertion(\+ var(Nil)), Nil==[], !.
  370props_to_list(end_of_list, []):- !.
  371props_to_list(Before, [After]):- (correct_prop(Before, After) -> Before\==After), !.
  372props_to_list(NC, [nc(NC)]):- \+ compound(NC), !.
  373props_to_list(oper(_, _, _), []):- !.
  374props_to_list([A|B], ABL):- !,
  375   props_to_list(A, AL),
  376   props_to_list(B, BL),
  377   append(AL, BL, ABL).
  378props_to_list((A, B), ABL):- !,
  379   props_to_list(A, AL),
  380   props_to_list(B, BL),
  381   append(AL, BL, ABL).
  382props_to_list(Other, [Other]).
  383
  384correct_prop(NC, NO):- var(NC), !, NC = NO.
  385correct_prop(Type, inherit(Type, t)):- atom(Type).
  386correct_prop(NC, nc(NC)):- \+ compound(NC), !.
  387correct_prop(~(Type), inherit(Type, f)):- atom(Type), !.
  388correct_prop(HPRED, h(FS, X, Y)):- HPRED=..[F, S, X, Y], is_spatial_rel(F), !, FS=..[F, S].
  389correct_prop(HPRED, h(F, X, Y)):- HPRED=..[F, X, Y], is_spatial_rel(F), !.
  390correct_prop(SV, N=V):- SV=..[N, V], single_valued_prop(N), !.
  391correct_prop((can(Verb)), can_be(Verb, t)):- nop(check_atom(Verb)).
  392correct_prop(~(can(Verb)), can_be(Verb, f)):- nop(check_atom(Verb)).
  393correct_prop((knows_verbs(Verb)), knows_verbs(Verb, t)):- nop(check_atom(Verb)).
  394correct_prop(~(knows_verbs(Verb)), knows_verbs(Verb, f)):- nop(check_atom(Verb)).
  395correct_prop((has_rel(Verb)), has_rel(Verb, t)):- nop(check_atom(Verb)).
  396correct_prop(~(has_rel(Verb)), has_rel(Verb, f)):- nop(check_atom(Verb)).
  397correct_prop(isa(Type), inherit(Type, t)):- check_atom(Type), !.
  398correct_prop(isnt(Type), inherit(Type, f)):- check_atom(Type), !.
  399correct_prop(inherit(Type), inherit(Type, t)):- check_atom(Type), !.
  400correct_prop(Other,Other)