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/*
   21nearby_objs(Agent, Here, Nearby, S0):- 
   22 ignore(h(At, Agent, Here, S0)),
   23 findall_set(What,  
   24   (h(At, What, Here, S0),
   25    sub_objs(descended, Here, What, S0)),
   26   Nearby).
   27*/
   28
   29sub_objs(At, Here, What, S0):- 
   30  h(At, What, Here, S0),
   31 \+ ((h(inside, What, Container, S0), 
   32   Container\==Here, h(descended, Container, Here, S0))).
   33
   34prep_object_exitnames(in, Object, Exits, S0) :- 
   35  findall(Direction, h(exit(Direction), Object, _, S0), Exits), Exits\==[], !.
   36prep_object_exitnames(in, _Object, [escape], _S0) :- !.
   37prep_object_exitnames(on, _Object, [escape], _S0) :- !.
   38prep_object_exitnames(under, _Object, [escape], _S0) :- !.
   39prep_object_exitnames(at, _Object, [escape], _S0) :- !.
   40prep_object_exitnames(Other, _Object, [reverse(Other)], _S0).
   41
   42
   43is_prop_public(_,N,_):- N == 5, !.
   44is_prop_public(_,N,_):- N == 4, admin, !.
   45is_prop_public(Sense, N, Prop):- is_prop_public_at(Sense,NL, Prop), !, N >= NL.
   46% is_prop_public(_,1,_):- !.
   47
   48is_prop_public_at(_,_, P):- \+ callable(P),!,fail.
   49
   50% stared at
   51is_prop_public_at(see,3, desc).
   52is_prop_public_at(see,3, volume_capacity).
   53is_prop_public_at(see,3, volume).
   54% groped
   55is_prop_public_at(touch,3, locked).
   56
   57% looked 
   58is_prop_public_at(see,2, shiny).
   59is_prop_public_at(see,2, opened).
   60is_prop_public_at(see,2, worn_on).
   61is_prop_public_at(_, 2, has_rel).
   62is_prop_public_at(see,2, emitting).
   63% felt
   64is_prop_public_at(touch,2, shape).
   65is_prop_public_at(touch,2, volume).
   66
   67% glanced
   68is_prop_public_at(see,1, in). % has_rel
   69is_prop_public_at(see,1, on). % has_rel
   70is_prop_public_at(see,1, shape).
   71% bumped
   72is_prop_public_at(touch,1, texture).
   73
   74% parsing
   75is_prop_public_at(know,1, name).
   76is_prop_public_at(know,1, adjs).
   77is_prop_public_at(know,1, nouns).
   78is_prop_public_at(know,1, default_rel).
   79
   80% dunno where to put eatable
   81is_prop_public_at(know,2, eat).
   82
   83% debugging
   84is_prop_public_at(know,3, inherit).
   85is_prop_public_at(know,3, isnt).
   86is_prop_public_at(know,3, inheriting).
   87is_prop_public_at(know,3, inherited).
   88
   89is_prop_public_at(know,4, held_by).
   90is_prop_public_at(know,4, class_desc).
   91is_prop_public_at(know,4, has_sense).
   92is_prop_public_at(know,4, knows_verbs).
   93is_prop_public_at(know,4, can_be).
   94
   95is_prop_public_at(see, 5, co(_)).
   96
   97% action = try it to find out
   98is_prop_public_at(action,3, move).
   99is_prop_public_at(action,5, effect).
  100is_prop_public_at(action,5, after).
  101is_prop_public_at(action,5, before).
  102is_prop_public_at(action,5, breaks_into).
  103is_prop_public_at(action,5, oper).
  104is_prop_public_at(action,5, cant_go).
  105is_prop_public_at(_, N, P):- var(N), compound(P), functor(P,F,_), is_prop_public_at(action, 5, F), !, N = 5.
  106
  107is_prop_public_at(_,_, P):- \+ compound(P), !, fail.
  108is_prop_public_at(S,N, F = _):- !, is_prop_public_at(S, N, F).
  109is_prop_public_at(S,N, P):- functor(P,F,_), is_prop_public_at(S, N, F).
  110is_prop_public_at(S,N, P) :- arg(1, P, F), is_prop_public_at(S, N, F).
  111
  112object_props(Object, Sense, PropDepth, PropList, S0):- 
  113 findall(P, (getprop(Object, P, S0), is_prop_public(Sense, PropDepth, P)), PropListL),
  114 list_to_set(PropListL,PropList), !.
  115                                   
  116:- meta_predicate(maybe_send_sense(0,*,*,*,*,*,*)).  117maybe_send_sense(IF, Agent, Sense, Depth, Data, S0, S1):- 
  118 call(IF) ->
  119   send_sense(Agent, Sense, Depth, Data, S0, S1)
  120  ; S0 = S1.
  121
  122send_sense(Agent, Sense, Depth, Data, S0, S1):- 
  123   queue_agent_percept(Agent, percept(Agent, Sense, Depth, Data), S0, S1).
  124
  125act_examine(Agent, Sense, PrepIn, Object, Depth, SA, S3):- 
  126 object_props(Object, know, Depth, KPropList, SA), 
  127 maybe_send_sense((KPropList\==[]), Agent, know, Depth, props(Object, KPropList), SA, S0 ),
  128 object_props(Object, Sense, Depth, PropList, SA), 
  129 maybe_send_sense((PropList\==[]),Agent, Sense, Depth, props(Object, PropList), S0, S1),
  130 add_child_precepts(Sense,Agent,PrepIn, Depth, Object, S1, S2),
  131 (Depth>2 -> 
  132   (prep_object_exitnames(PrepIn, Object, Exits, S0),
  133       send_sense(Agent, Sense, Depth, exit_list(PrepIn, Object, Exits), S2, S3)) 
  134    ; S2 = S3),!.
  135
  136
  137get_relation_list(Object, RelationSet, S1) :- 
  138  findall_set(At, 
  139     ((getprop(Object,has_rel(At,t),S1);      
  140      (declared(h(At, _, Object),S1))), 
  141     At\=exit(_)), RelationSet).
  142
  143% add_child_precepts(_Sense, _Agent, _PrepIn, Depth, _Object, S1, S1):- Depth > 2, !.
  144add_child_precepts(Sense, Agent, PrepIn, Depth, Object, S1, S2):- 
  145 get_relation_list(Object, RelationSet, S1),
  146 (member(PrepIn,RelationSet) -> UseRelationSet = [PrepIn] ; UseRelationSet= RelationSet),
  147 % dmsg(get_relation_list(Object, RelationSet)),
  148 findall(percept(Agent, Sense, Depth, child_list(Object, At, Children)),
  149     ((member(At,UseRelationSet),
  150       child_precepts(Agent, Sense, Object, At, Depth, Children, S1))), PreceptS),
  151 queue_agent_percept(Agent,PreceptS, S1, S2).
  152
  153child_precepts(Agent, Sense, Object, At, Depth, Children, S0):-  At == at,
  154 getprop(Object, default_rel = Default, S0), Default\==At, !,
  155 child_precepts(Agent, Sense, Object, Default, Depth, Children, S0).
  156child_precepts(_Agent, _All, Object, At, _Depth, '<mystery>'(closed,At,Object), S1):- is_closed(At, Object, S1),!.
  157/*act_examine(Agent, Sense, At, Here, Depth, S0, S9):-  At == at,
  158 getprop(Object, default_rel = Default, S0), Default\==At, !,
  159 act_examine(Agent, Sense, Default, Here, Depth, S0, S9).
  160*/
  161child_precepts(Agent, Sense, Object, At, _Depth, Children, S1):- 
  162 findall_set(What,  
  163  (h(At, What, Object, S1), 
  164   nop(once(can_sense(Agent, Sense, What, S1)))), 
  165   Children)