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
   21% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   22% CODE FILE SECTION
   23:- nop(ensure_loaded('adv_relation')).   24% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   25
   26:- defn_state_none(never_equal(sense,inst,agent)).   27never_equal(Sense,Thing,Agent):- nop(never_equal(Sense,Thing,Agent)),!.
   28never_equal(Sense,Thing,Agent):-
   29  never_equal(Sense,Thing),never_equal(Sense,Agent).
   30never_equal(Sense,Thing):-
   31 notrace((freeze(Thing, (must_det(Thing\==Sense))), freeze(Sense, (must_det(Thing\==Sense))))).
   32
   33
   34
   35% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   36% CODE FILE SECTION
   37:- nop(ensure_loaded('adv_relation')).   38% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   39
   40:- defn_state_getter(related_with_prop(domrel, inst, place, prop)).   41related_with_prop(At, Object, Place, Prop, S0) :-
   42  h(At, Object, Place, S0),
   43  getprop(Object, Prop, S0).
   44
   45% getprop(Object, can_be(open, S0),
   46% \+ getprop(Object, =(open, t), S0).
   47
   48
   49% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   50% CODE FILE SECTION
   51:- nop(ensure_loaded('adv_relation')).   52% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   53
   54
   55% -----------------------------------------------------------------------------
   56
   57subrelation(in, child).
   58subrelation(on, child).
   59subrelation(worn_by, child).
   60subrelation(held_by, child).
   61subrelation(Sub, child_not_in):- dif(Sub,in), subrelation(Sub, child).
   62%subrelation(under, in).
   63%subrelation(reverse(on), child).
   64
   65same_rel(Rel,Prep):- Rel==Prep.
   66same_rel(Rel,Prep):- \+ ground((Rel,Prep)),!, fail.
   67same_rel(Rel,Prep):- compound(Prep),!,arg(_,Prep,E),same_rel(Rel,E).
   68same_rel(Rel,Prep):- compound(Rel),!,arg(_,Rel,E),same_rel(E,Prep).
   69same_rel(Rel,Prep):- subrelation(Rel,Prep).
   70
   71:- defn_state_getter(prep_to_rel(target,preprel,-domrel)).   72prep_to_rel(Target, Prep, Rel, S0):- has_rel(Rel, Target, S0), same_rel(Rel,Prep),!.
   73prep_to_rel(Target, Prep, Rel, S0):- in_model(h(Rel, Target, _), S0), same_rel(Rel,Prep), !. 
   74prep_to_rel(Target, Prep, Rel, S0):- atom(Prep), prep_to_rel(Target, exit(Prep), Rel, S0),!.
   75prep_to_rel(Target, _Prep, Rel, S0):- default_rel(Rel, Target, S0).
   76
   77:- defn_state_getter(has_rel(domrel,inst)).   78has_rel(At, X, S0) :- default_rel(At, X, S0).
   79
   80:- defn_state_getter(default_rel(domrel,inst)).   81default_rel(At, X, S0) :-
   82  getprop(X, default_rel = (At), S0).
   83default_rel(At, X, S0) :-
   84  getprop(X, has_rel(At, TF), S0), TF \== f.
   85default_rel(in, _, _S0) :- !.
   86
   87default_rel(At, X, S0) :-
   88  getprop(X, default_rel = (Specific), S0),
   89  subrelation(Specific, At).
   90default_rel(At, X, S0) :-
   91  getprop(X, has_rel(Specific, TF), S0), TF \== f,
   92  subrelation(Specific, At).
   93
   94
   95:- defn_state_getter(h(domrel,source,target)).   96
   97h(At, X, Y, S0) :- in_model(h(At, X, Y), S0).
   98
   99h(child, X, Y, S0) :- subrelation(At, child), h(At, X, Y, S0).
  100
  101h(descended, X, Z, S0) :-
  102  h(child, X, Z, S0).
  103h(descended, X, Z, S0) :- 
  104  h(child, Y, Z, S0),
  105  h(descended, X, Y, S0).
  106
  107h(open_traverse, X, Z, S0):-
  108  h(descended, X, Z, S0),
  109  \+ (h(inside, X, Z, S0), is_closed(in, Z, S0)).
  110
  111h(in_scope, X, Z, S0):- 
  112  h(child, X, Y, S0),
  113  h(descended, Z, Y, S0).
  114h(in_scope, X, Z, S0):- 
  115  h(descended, X, Z, S0).
  116
  117h(touchable, X, Z, S0):- 
  118  h(in_scope, X, Z, S0),
  119  \+ ((h(inside, Z, C, S0), is_closed(in, C, S0),   % cant reach what is inside of something closed unless...
  120                          \+ h(inside, X, C, S0))). % ... we are inside of that something as well as well
  121
  122h(takeable, X, Z, S0):- 
  123  h(touchable, X, Z, S0),
  124  X \= Z, % cant take self
  125  \+ getprop(Z,can_be(move, f)),
  126  \+ getprop(Z,can_be(take, f)),
  127  \+ h(inside, X, Z, S0),  % cant take outer object
  128  \+ h(held_by, Z, X, S0). % cant take what already have
  129
  130
  131h(inside, X, Z, S0) :- h(in, X, Z, S0).
  132h(inside, X, Z, S0) :- h(in, Y, Z, S0),
  133          h(descended, X, Y, S0).
  134
  135h(exit(Out), Inner, Outer, S0) :- in_out(In,Out),
  136  h(child, Inner, Outer, S0),
  137  has_rel(In, Inner, S0),
  138  has_rel(child, Outer, S0),
  139  \+ is_closed(In, Inner, S0),!.
  140h(exit(Off), Inner, Outer, S0) :- on_off(On,Off),
  141  h(child, Inner, Outer, S0),
  142  has_rel(On, Inner, S0),
  143  has_rel(child, Outer, S0),!.
  144h(exit(Escape), Inner, Outer, S0) :- escape_rel(Escape),
  145  h(child, Inner, Outer, S0),
  146  has_rel(child, Inner, S0),
  147  has_rel(child, Outer, S0),!.
  148
  149
  150in_out(in,out).
  151on_off(on,off).
  152escape_rel(escape).
  153
  154:- defn_state_getter(is_closed(prep,inst)).  155
  156:- defn_state_getter(in_state(domrel, inst)).  157in_state(~(Opened), Object, S0) :- ground(Opened),!,
  158 getprop(Object, Opened=f, S0).
  159in_state(Opened, Object, S0) :-
  160 getprop(Object, Opened=t, S0).
  161
  162:- defn_state_getter(is_closed(domrel, inst)).  163is_closed(At,Object, S0) :-  
  164 in_state(~(opened), Object, S0) -> getprop(Object, default_rel = At, S0).
  165%  getprop(Object, openable, S0),
  166%  \+ getprop(Object, open, S0).
  167
  168  
  169:- defn_state_getter(from_loc(inst, place)).  170
  171from_loc(Thing, Here, S0):- 
  172   h(child, Thing, Here, S0), !.
  173from_loc(Thing, Here, S0):- 
  174   h(open_traverse, Thing, Here, S0), !.
  175from_loc(Thing, Here, S0):- 
  176   h(_, Thing, Here, S0), !.
  177
  178:- defn_state_getter(open_traverse(inst,here)).  179
  180open_traverse(Thing, Here, S0):- 
  181   h(open_traverse, Thing, Here, S0).
  182open_traverse(Thing, Here, S0):- 
  183   h(open_traverse, Here, Thing, S0).
  184
  185
  186
  187
  188
  189% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  190% CODE FILE SECTION
  191:- nop(ensure_loaded('adv_action')).  192% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  193
  194:- defn_state_getter(applied_direction(start,source,prep,domrel,target)).  195applied_direction(Start, Here, Dir, Relation, End, S0):- 
  196 h(_Relation, Start, Here, S0),
  197 h(exit(Dir), Here, End, S0),
  198 has_rel(Relation, End, S0)