1% :-swi_module(user). 
    2:-swi_module(modInventory, [mudInventoryLocation/3,show_inventory/2]).    3/* * module * A command to  ...
    4% Douglas Miles 2014
    5% inventory(Agt,Inv) = inventory (anything the agent has taken)
    6*/
    7:- include(prologmud(mud_header)).    8
    9% :- register_module_type (mtCommand).
   10
   11prologBuiltin(nearest_reachable_object(tAgent,tObj)).
   12prologBuiltin(farthest_reachable_object(tAgent,tObj)).
   13
   14% ====================================================
   15% the entire inventory system
   16% ====================================================
   17tCol(tNearestReachableItem).
   18tNearestReachableItem(Obj):-
   19  current_agent(Agent),
   20  nearest_reachable_object(Agent,Obj).
   21
   22tCol(tFarthestReachableItem).
   23tFarthestReachableItem(Obj):-
   24  current_agent(Agent),
   25  farthest_reachable_object(Agent,Obj).
   26
   27
   28
   29nearest_reachable_object(Agent,Obj):- 
   30  with_no_modifications((findall(Obj,farthest_reachable_object(Agent,Obj),List),reverse(List,Reverse),!,member(Obj,Reverse))).
   31
   32prologBuiltin(farthest_reachable_object(tAgent,tObj)).
   33farthest_reachable_object(Agent,Obj):-with_no_modifications((farthest_reachable_object0(Agent,Obj))).
   34farthest_reachable_object0(Agent,Obj):-
   35  test_exists(Obj),
   36  dif(Agent,Obj),
   37  localityOfObject(Agent,LOC),
   38  localityOfObject(Obj,LOC).
   39farthest_reachable_object0(Agent,Obj):-
   40  test_exists(Obj),
   41  dif(Agent,Obj),
   42  mudAtLoc(Agent,LOC),
   43  mudAtLoc(Obj,LOC).
   44farthest_reachable_object0(Agent,Obj):-
   45  test_exists(Obj),
   46  dif(Agent,Obj),
   47  localityOfObject(Obj,Agent).
   48farthest_reachable_object0(Agent,Obj):-
   49  test_exists(Obj),
   50  mudPossess(Agent,Obj).
   51
   52% detatch from world
   53detatch_object(Obj):-  
   54  (req1(mudPossess(Agent,Obj))->clr(mudPossess(Agent,Obj));true),
   55  (req1(mudAtLoc(Obj,LOC))-> clr(mudAtLoc(Obj,LOC));true),
   56  (req1(localityOfObject(Obj,R))-> clr(localityOfObject(Obj,R));true),
   57  (clr(inRegion(Obj,_))),!.
   58   
   59% destroy from ontology
   60destroy_instance(Obj):- % forall(isa(Obj,Col),mpred_remove(isa(Obj,Col))),
   61                        xlisting_inner(destroy_clause(Obj),contains(Obj),[]),!.
   62
   63:-export(destroy_clause/4).   64destroy_clause(Obj,H,B,R):- 
   65  call(call,baseKB:(nonvar(R),catch(clause_property(R,_),_,fail) 
   66    ->clause(M:HH,BB,R)->M\==lmcache->contains_var(Obj,clause(HH,BB,R))->erase(R))),
   67  dmsg(destroy_clause(H,B,R)),!,
   68  must(mpred_undo((M:HH:-BB))),!.
   69destroy_clause(Obj,H,B,R):- wdmsg(misssed_destroy_clause(Obj,H,B,R)).
   70   
   71
   72baseKB:action_info(actInventory(isOptional(tAgent,isSelfAgent)), "Examine an inventory").
   73
   74baseKB:agent_call_command(Agent,actInventory(Who)):- show_inventory(Agent,Who).
   75baseKB:agent_call_command(Agent,actInventory):- show_inventory(Agent,Agent).
   76
   77show_inventory(Agent,Who):-
   78        show_kb_preds(Agent,[                                                  
   79                        % listof(mudInventoryLocation(Who, value, _)),
   80                        listof(mudContains(Who,value)),                 
   81                        listof(mudPossess(Who,value)),
   82                        listof(mudStowing(Who,value)),                       
   83                        listof(mudWielding(Who,value)),
   84                        listof(wearsClothing(Who,value))]).
   85
   86
   87mudInventoryLocation(Who,Obj,Loc):- 
   88         findall(props(Obj,PRED),
   89                  (member(t(PRED,A,B), [
   90                        t(mudPossess,Who,Obj),
   91                        t(mudStowing,Who,Obj),
   92                        t(mudContains,Who,Obj),
   93                        t(mudWielding,Who,Obj),
   94                        t(wearsClothing,Who,Obj)]),
   95                     ireq(t(PRED,A,B))),
   96                  RESULTS),
   97         setof(Obj,member(props(Obj,PRED),RESULTS),OBJLIST),!,
   98         member(Obj,OBJLIST),once((member(PRED2,[mudAtLoc,localityOfObject]),ireq(t(PRED2,Obj,Loc)))).
   99
  100test_exists(O):- tItem(O).
  101test_exists(O):- tAgent(O).
  102test_exists(O):- tRegion(O).
  103test_anyInst(O):- tCol(O).
  104test_anyInst(O):- test_exists(O).
  105
  106% helps for testings
  107% :- listing(inventory:_).
  108
  109:- include(prologmud(mud_footer)).