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:- ensure_loaded(adv_naming).
   20
   21filter_spec(true,_):- !.
   22filter_spec( \+ Spec, PropList):- !,
   23 \+ filter_spec(Spec, PropList).
   24filter_spec((Spec1;Spec2), PropList):- !, filter_spec(Spec1, PropList);filter_spec(Spec2, PropList).
   25filter_spec((Spec1, Spec2), PropList):- !, filter_spec(Spec1, PropList), filter_spec(Spec2, PropList).
   26filter_spec( Spec, PropList):- declared(Spec, PropList).
   27
   28create_new_unlocated(Type,Inst,S0,S2):- 
   29 atom_concat(Type,'~',TType),gensym(TType,Inst),
   30 declare_inst_type(Inst,Type,S0,S2).
   31
   32create_new_suffixed_unlocated(Suffix, Type,Inst,S0,S2):- 
   33 atom_concat(Type,Suffix,Inst),
   34 declare_inst_type(Inst,Type,S0,S2).
   35
   36declare_inst_type(Inst,Type,S0,S2):- 
   37  assertion(nonvar(Inst)),
   38  assertion(nonvar(Type)),
   39  object_props_or(Inst, PropList1, [], S0),
   40  undeclare_always(props(Inst,_), S0, S1),
   41  (member(adjs(_),PropList1)-> PropList1=PropList;  [nouns([Type])|PropList1]=PropList),
   42  list_to_set([shape=Type,inherit(Type,t)|PropList],Set),
   43  declare(props(Inst,Set),S1,S2).
   44
   45% create_agent_conn(Agent,_Named, _Info, S0, S0) :- declared(agent(Agent,t), S0),!.
   46 %create_new_unlocated('watch',Watch),
   47    %create_new_unlocated('bag',Bag),
   48    %create_new_unlocated('coins',Coins),
   49     % h(worn_by, Watch, Agent),
   50    %h(in, Bag, Coins),
   51    %h(held_by, Bag, Agent),
   52create_agent_conn(Agent,Named,Info,S0,S9):- 
   53 declare(((props(Agent, 
   54      [name(['Telnet:',Named]), inherit(telnet,t), inherit(humanoid,t), inherit(player,t), info(Info)]),
   55      h(in, Agent, kitchen))),
   56  S0,S1),
   57 init_objects(S1,S9), !.
   58
   59
   60init_objects(S0, S2) :-
   61 must_det((must_input_state(S0), 
   62 create_missing_instances(S0,S1), !,
   63 must_det(call((get_objects(true,ObjectList, S1), ObjectList\==[]))),
   64 bugout1(iObjectList = ObjectList), 
   65 apply_mapl_state(create_object(), ObjectList, S1, S2),
   66 must_output_state(S2))).
   67
   68
   69%create_object(Agent, S0, S2) :- declared(perceptq(Agent, []), S0), !,
   70% bugout1(existingAgent=Agent),
   71% S2=S0.
   72     
   73create_object(Object, S0, S0) :- declared(props(Object,PropList), S0), member(co(_),PropList),!.
   74create_object(Object, S0, S9) :- 
   75 object_props_or(Object, PropList, [], S0),!,
   76 bugout1(create_object(Object,PropList)),
   77 undeclare_always(props(Object,_), S0, S2),
   78 declare(props(Object,[co(PropList)]), S2, S3),
   79 create_objprop(Object, PropList, S3, S9). 
   80/*
   81visit_existing(_Object, [], S0, S0) :-!.
   82visit_existing(Object, [Prop|List], S0, S2):- !, 
   83 visit_existing(Object, List, S0, S1),
   84 visit_existing(Object, Prop, S1, S2).
   85
   86%visit_existing(Object, Prop, S1, S2):- must_det(create_objprop(Object, Prop, S1, S2)).
   87
   88visit_existing(Object, Prop, S1, S2):- Prop=inherit(_,t),!,must_det(create_objprop(Object, Prop, S1, S2)).
   89visit_existing(Object, Prop, S0, S2):- must_det(updateprop(Object,Prop,S0, S2)).
   90*/ 
   91
   92create_objprop(_Object, [], S0, S0):- !.
   93create_objprop(Object, [Prop|List], S0, S2):- !,
   94 create_objprop(Object, List, S0, S1),
   95 create_objprop(Object, Prop, S1, S2).
   96
   97 % As events happen, percepts are entered in the percept queue of each agent.
   98 % Each agent empties their percept queue as they see fit.
   99create_objprop(Object, inherit(perceptq,t), S0, S0):- declared(perceptq(Object,_),S0),!.
  100create_objprop(Object, inherit(perceptq,t), S0, S1):- !,
  101 declare(perceptq(Object, []), S0, S1).
  102
  103 % Most agents store memories of percepts, world model, goals, etc.
  104create_objprop(Object, inherit(memorize,t), S0, S0):- declared(memories(Object,_),S0),!.
  105create_objprop(Self, inherit(memorize,t), S0, S2):- !, clock_time(Now),
  106 declare(memories(Self, [
  107 structure_label(mem(Self)),
  108 timestamp(0,Now), 
  109 goals([]),
  110 goals_skipped([]),
  111 goals_satisfied([]),
  112 % model([]),
  113 todo([look(Self)]),
  114 inst(Self)]), S0, S2).
  115
  116
  117create_objprop(Object, inherit(Other,f), S0, S0):- getprop(Object, isnt(Other), S0),!. 
  118create_objprop(Object, inherit(Other,f)) -->
  119   updateprop(Object, isnt(Other)), 
  120   delprop_always(Object, inherited(Other)),
  121   delprop_always(Object, inherit(Other,t)),
  122   updateprop(Object, inherit(Other,f)).
  123    
  124create_objprop(Object, inherit(Other,t), S0, S2):- getprop(Object,inherit(Other,f),S0),!,updateprop(Object, inherit(Other,t), S0, S1),create_objprop(Object, inherit(Other,t), S1, S2).
  125create_objprop(Object, inherit(Other,t), S0, S0):- getprop(Object,inherited(Other),S0),!.
  126create_objprop(Object, inherit(Other,t), S0, S0):- getprop(Object,isnt(Other),S0),!.
  127create_objprop(Object, inherit(Other,t), S0, S0):- Other==Object,!.
  128create_objprop(_Object, inherit(Other,t), S0, S0):- direct_props(Other, PropList, S0), member(no_copy(t),PropList),!.
  129create_objprop(Object, inherit(Other,t), S0, S9):- 
  130 direct_props_or(Other, PropList0, [], S0),
  131 adv_subst(PropList0,$class,Other,PropList1),
  132 (member(adjs(_),PropList1)-> PropList1=PropList;  [nouns([Other])|PropList1]=PropList),
  133 copy_term(PropList,PropListC),!,
  134 % must_det(updateprop(Object, inherit(Other,t), S5, S9)), !,
  135 %must_det(updateprop(Object, visited(Other), S0, S1)),
  136 must_det(updateprop(Object, inherited(Other), S0, S2)),
  137 
  138 must_det(create_objprop(Object, PropListC, S2, S9)),
  139 %must_det(setprop(Object, inherited(Other), S3, S9)),
  140 !.
  141
  142%create_objprop(Object, inherit(Other,t), S0, S0):- getprop(Object,inherited(Other),S0),!.
  143
  144create_objprop(Object, Prop, S0, S2):- 
  145 adv_subst(equivalent,$self,Object,Prop,NewProp),Prop\==NewProp,!,
  146 create_objprop(Object, NewProp, S0, S2).
  147create_objprop(Object, Prop, S0, S2):- must_det(updateprop(Object,Prop,S0, S2)).
  148
  149
  150
  151create_missing_instances(S0,S2):- 

  152 gensym('~',Sym),
  153 create_instances(Sym,S0,S0,S0,S2).

  154

  155may_contain_insts(h).
  156% may_contain_insts(holds_at).
  157
  158create_instances(Suffix,Info,[Prop|TODO],S0,S3):-

  159 Prop =.. [F, Pred | Objs], 
  160 may_contain_insts(F),member(Obj,Objs),compound(Obj),!,
  161 must_det((select(Prop,S0,S1))),
  162 must_det((create_objs(Objs,NewObjs,Suffix,Info,S1,S2),
  163 NewProp =.. [F, Pred | NewObjs],

  164 create_instances(Suffix,Info,TODO,[NewProp|S2],S3))).
  165 

  166create_instances(Suffix,Info,[_|TODO],S0,S2):-
  167 create_instances(Suffix,Info,TODO,S0,S2).

  168create_instances(_Suffix,_Info,[],S0,S0).

  169

  170
  171create_objs([Obj|Objs],[NewObj|NewObjs],Suffix,Info,S0,S2):-
  172 wdmsg(create_1obj(Suffix,Info,Obj,NewObj)),
  173 must_det(create_1obj(Suffix,Info,Obj,NewObj,S0,S1)),
  174 create_objs(Objs,NewObjs,Suffix,Info,S1,S2).
  175create_objs([],[],_Suffix,_Info,S0,S0).
  176
  177
  178create_1obj(Suffix,_Info,a(Type),Inst,S0,S2):- !, 
  179 must_det(create_new_suffixed_unlocated(Suffix,Type,Inst,S0,S2)).
  180create_1obj(Suffix,_Info,the(Type),Inst,S0,S2):- !, 
  181 must_det(create_new_suffixed_unlocated(Suffix,Type,Inst,S0,S2)).
  182
  183create_1obj(Suffix,Info,the(Type),Inst,S0,S2):- find_recent(Suffix,Type,Inst,S0,S2)->true;create_1obj(Suffix,Info,Type,Inst,S0,S2).
  184create_1obj(_Suffix,_Info,I,I, S0,S0):- atom_contains(I,'~').

  185create_1obj(_Suffix,_Info,I,I, S0,S0):- assertion(atom(I)),!.

  186
  187find_recent(_Suffix,Type,Inst,S0,S0):- declared(props(Inst,PropList),S0),declared(instance(Type),PropList).
  188

  189%inst_of(I,C,N):- compound(I),!,I=..[C,N|_],number(N).

  190inst_of(I,C,N):- I\==[], (atom(C);var(C)), (integer(N);var(N)), atom(I),!, atomic_list_concat([C,NN],'~',I),atom_number(NN,N).

  191%inst_of(I,C,N):- atom(C),atomic_list_concat([C,NN],'~',I),atom_number(NN,N).