1/* * <module> File used to implement in_world_events
    2% like Talking, Appearing, falling rocks..
    3%
    4% Logicmoo Project PrologMUD: A MUD server written in Prolog
    5% Maintainer: Douglas Miles
    6% Dec 13, 2035
    7%
    8*/
    9% :-swi_module(world_events,[]).
   10
   11:- include(prologmud(mud_header)).   12
   13
   14asInvoked(Cmd,[L|Ist]):-stack_check,once(append([L|Ist],[],Foo)),Foo\==[L|Ist],!,asInvoked(Cmd,Foo).
   15asInvoked(Cmd,[L|Ist]):-atom(L),not(bad_functor(L)),!, Cmd=..[L|Ist].
   16asInvoked(Cmd,[L|Ist]):-!,Cmd=..[asInvoked,L|Ist].
   17asInvoked(Cmd,Cmd):-!.
   18
   19prologBuiltin(mudObjNearLoc(tObj,tObj)).
   20mudObjNearLoc(Whom,Where):-nonvar(Where),!,findall(Whom,atlocNear0(Whom,Where),List),list_to_set(List,Set),!,member(Whom,Set).
   21mudObjNearLoc(Whom,Where):-nonvar(Whom),!,findall(Where,atlocNear0(Whom,Where),List),list_to_set(List,Set),!,member(Where,Set).
   22mudObjNearLoc(Whom,Where):-findall(Whom+Where,atlocNear0(Whom,Where),List),list_to_set(List,Set),!,member(Whom+Where,Set).
   23
   24atlocNear0(Whom,Where):-!,mudNearbyLocs(Where,LOC),clause_asserted(mudAtLoc(Whom,LOC)).
   25atlocNear0(Whom,Where):-mudNearbyLocs(Where,LOC),is_asserted(mudAtLoc(Whom,LOC)).
   26
   27
   28:-export(raise_location_event/2).   29raise_location_event(Where,Event):- forall(no_repeats(Whom,(no_repeats(tAgent(Whom)),mudObjNearLoc(Whom,Where))),
   30   deliver_event(Whom,Event)).
   31deliver_event(Whom,Event):- quietly(doall(call_no_cuts(baseKB:deliver_event_hooks(Whom,Event)))).
   32
   33
   34% :-export(mudDeliverableLocationEvents/3).
   35:-dynamic(baseKB:mudDeliverableLocationEvents/3).   36prologHybrid(mudDeliverableLocationEvents(tAgent,tRegion,ftTerm))