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
   20filter_spec(true,_):- !.
   21filter_spec( \+ Spec, PropList):- !,
   22  \+  filter_spec(Spec, PropList).
   23filter_spec((Spec1;Spec2), PropList):- !, filter_spec(Spec1, PropList);filter_spec(Spec2, PropList).
   24filter_spec((Spec1, Spec2), PropList):- !, filter_spec(Spec1, PropList), filter_spec(Spec2, PropList).
   25filter_spec(    Spec, PropList):- member(Spec, PropList).
   26
   27create_new_unlocated(Type,Inst,S0,S2):- 
   28  atom_concat(Type,'~',TType),gensym(TType,Inst),
   29  declare(props(Inst,[inherit(Type,t)]),S0,S2).
   30create_new_suffixed_unlocated(Suffix, Type,Inst,S0,S2):- 
   31  atom_concat(Type,Suffix,Inst),
   32  declare(props(Inst,[inherit(Type,t)]),S0,S2).
   33
   34% create_agent_conn(Agent,_Named, _Info, S0, S0) :- declared(agent(Agent,t), S0),!.
   35create_agent_conn(Agent,Named,Info,S0,S9):- 
   36   apply_state([%create_new_unlocated('watch',Watch),
   37                %create_new_unlocated('bag',Bag),
   38                %create_new_unlocated('coins',Coins),
   39   declare(
   40     (props(Agent, [name(['Telnet:',Named]), inherit(telnet,t), inherit(humanoid,t), inherit(player,t), info(Info)]),               
   41               
   42               % h(Spatial, worn_by, Watch, Agent),
   43               %h(Spatial, in, Bag, Coins),
   44               %h(Spatial, held_by, Bag, Agent),
   45               h(spatial, in, Agent, kitchen)))],S0,S1),
   46   init_objects(S1,S9).
   47
   48
   49init_objects(S0, S2) :-
   50  must_input_state(S0),
   51  create_missing_instances(S0,S1),
   52  dmust(call((get_objects(true,ObjectList, S1), ObjectList\==[]))),

   53  dbug(iObjectList  = ObjectList),
   54  apply_all(ObjectList, create_object(), S1, S2),

   55  must_output_state(S2), !.
   56
   57
   58%create_object(Agent, S0, S2) :- declared(perceptq(Agent, []), S0), !,
   59%  dbug(existingAgent=Agent),
   60%  S2=S0.
   61                   
   62create_object(Object, S0, S0) :- declared(object(Object,t), S0),!.
   63create_object(Object, S0, S2) :- 
   64   dbug(create_object(Object)),
   65   declare(object(Object,t), S0, S1),
   66   (declared(props(Object, PropList), S0);PropList=[]),!,
   67   %visit_existing(Object, PropList,S1, S2).
   68   create_objprop(Object, PropList,S1, S2).
   69/*
   70visit_existing(_Object, [], S0, S0) :-!.
   71visit_existing(Object, [Prop|List], S0, S2):- !,  
   72   visit_existing(Object, List, S0, S1),
   73   visit_existing(Object, Prop, S1, S2).
   74
   75%visit_existing(Object, Prop, S1, S2):- dmust(create_objprop(Object, Prop, S1, S2)).
   76
   77visit_existing(Object, Prop, S1, S2):- Prop=inherit(_,t),!,dmust(create_objprop(Object, Prop, S1, S2)).
   78visit_existing(Object, Prop, S0, S2):- dmust(updateprop(Object,Prop,S0, S2)).
   79*/  
   80
   81create_objprop(_Object, [], S0, S0).
   82create_objprop(Object, [Prop|List], S0, S2):- !,
   83   create_objprop(Object, List, S0, S1),
   84   create_objprop(Object, Prop, S1, S2).
   85
   86create_objprop(Object, inherit(Other,t), S0, S0):- getprop(Object,inherited(Other),S0),!.
   87create_objprop(Object, inherit(Other,t), S0, S0):- getprop(Object,isnt(Other),S0),!.
   88create_objprop(Object, inherit(Other,t), S0, S0):- Other==Object,!.
   89
   90  % As events happen, percepts are entered in the percept queue of each agent.
   91  % Each agent empties their percept queue as they see fit.
   92create_objprop(Object, inherit(perceptq,t), S0, S0):- declared(perceptq(Object,_),S0),!.
   93create_objprop(Object, inherit(perceptq,t), S0, S1):- !,
   94   declare(perceptq(Object, []), S0, S1).
   95
   96  % Most agents store memories of percepts, world model, goals, etc.
   97create_objprop(Object, inherit(memorize,t), S0, S0):- declared(memories(Object,_),S0),!.
   98create_objprop(Object, inherit(memorize,t), S0, S2):- !,
   99  (declared(props(Object, PropList), S0);declared(class_props(Object, PropList), S0)),
  100  copy_term(PropList,PropListC),!,
  101  % =(PropList,PropListC),!,
  102  declare(memories(Object, [
  103    structure_label(mem(Object)),
  104    timestamp(0),
  105    model(spatial,[]),
  106    goals([]),
  107    todo([look]),
  108    inst(Object)|PropListC]), S0, S2).
  109
  110
  111create_objprop(Object, inherit(Other,t), S0, S9):- 
  112   (declared(props(Other, PropList), S0);declared(class_props(Other, PropList), S0); PropList=[]),!,
  113   copy_term(PropList,PropListC),!,
  114   dmust(setprop(Object, inherited(Other), S0, S1)), !,
  115   dmust(create_objprop(Object, PropListC, S1, S2)),
  116   dmust(setprop(Object, inherit(Other,t), S2, S3)), !,
  117   dmust(setprop(Object, inherited(Other), S3, S9)),
  118   !.
  119   
  120create_objprop(Object, Prop, S0, S2):- dmust(updateprop(Object,Prop,S0, S2)).
  121
  122
  123
  124create_missing_instances(S0,S2):- 

  125  create_instances('~1',S0,S0,S0,S2).

  126

  127may_contain_insts(h).
  128
  129create_instances(Suffix,Info,[Prop|TODO],S0,S3):-

  130 Prop =.. [F, Spatial, Pred | Objs], 
  131 may_contain_insts(F),member(Obj,Objs),compound(Obj),!,
  132 dmust((select(Prop,S0,S1))),
  133 dmust((create_objs(Objs,NewObjs,Suffix,Info,S1,S2),
  134 NewProp =.. [F, Spatial, Pred | NewObjs],

  135 create_instances(Suffix,Info,TODO,[NewProp|S2],S3))).
  136 

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

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

  140

  141
  142create_objs([Obj|Objs],[NewObj|NewObjs],Suffix,Info,S0,S2):-
  143  dmust(create_1obj(Suffix,Info,Obj,NewObj,S0,S1)),
  144  create_objs(Objs,NewObjs,Suffix,Info,S1,S2).
  145create_objs([],[],_Suffix,_Info,S0,S0).
  146
  147
  148create_1obj(Suffix,_Info,a(Type),Inst,S0,S2):- !, 
  149  dmust(create_new_suffixed_unlocated(Suffix,Type,Inst,S0,S2)).
  150
  151create_1obj(Suffix,Info,the(Type),Inst,S0,S2):-  find_recent(Suffix,Type,Inst,S0,S2)->true;create_1obj(Suffix,Info,Type,Inst,S0,S2).
  152create_1obj(_Suffix,_Info,I,I, S0,S0):- atom_contains(I,'~').

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

  154
  155find_recent(_Suffix,Type,Inst,S0,S0):- member(props(Inst,PropList),S0),member(instance(Type),PropList).
  156

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

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

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