1/* * module * 
    2% This is simple example pddl for the maze world.
    3%
    4%
    5% monster.pl
    6% July 11, 1996
    7% John Eikenberry
    8%
    9% Dec 13, 2035
   10% Douglas Miles
   11%
   12% Declare the module name and the exported (public) predicates.
   13*/
   14
   15
   16
   17% Declare the module name and the exported (public) predicates.
   18:-swi_module(modulePddlAgent,[]).   19
   20:- include(prologmud(mud_header)).   21% :- register_module_type (planning).
   22
   23ttAgentType(mobPddlAgent).
   24
   25pddl_vette_idea(Agent,Act,Act):-var(Act),!,dmsg(pddl_vette_idea(Agent,Act)).
   26pddl_vette_idea(_,actSit,actSit):-!.
   27pddl_vette_idea(Agent,Act,Act):-dmsg(pddl_vette_idea(Agent,Act)).
   28
   29
   30% ==>mudLabelTypeProps('oP',mobPddlAgent,[isa(tAgent)]).
   31typeHasGlyph(mobPddlAgent,"oP").
   32
   33world_agent_plan(_World,Agent,ActV):-
   34   tAgent(Agent),
   35   % isa(Agent,mobPddlAgent),
   36   pddl_idea(Agent,Act),
   37   pddl_vette_idea(Agent,Act,ActV).
   38
   39% Possible agent actions.
   40pddl_idea(Agent,actEat(Elixer)) :-
   41	mudHealth(Agent,Damage),
   42	Damage < 15,
   43   mudPossess(Agent,List),
   44   obj_memb(Elixer,List),
   45   isa(Elixer,tElixer).
   46
   47pddl_idea(Agent,actEat(tFood)) :-
   48	mudEnergy(Agent,Charge),
   49	Charge < 150,
   50   mudPossess(Agent,List),
   51   obj_memb(Food,List),
   52   isa(Food,tFood).
   53
   54pddl_idea(Agent,actTake(Good)) :-
   55	mudNearBody(Agent,What),
   56        obj_memb(Good,What),
   57	isa_any(Good,[tGold,tElixer,tTreasure]).  
   58
   59pddl_idea(Agent,actTake(Good)) :-
   60	mudNearBody(Agent,What),
   61        obj_memb(Good,What),
   62	isa_any(Good,[tFood,tUsefull,tItem]).
   63
   64pddl_idea(Agent,actMove(1,Dir)) :-
   65	mudGetPrecepts(Agent,List),
   66	list_object_dir_sensed(_,List,tTreasure,Dir).
   67
   68pddl_idea(Agent,actMove(3,Dir)) :-
   69	mudGetPrecepts(Agent,List),
   70	list_object_dir_sensed(_,List,mobMonster,OppDir),
   71	reverse_dir(OppDir,Dir),
   72	number_to_dir(N,Dir,vHere),
   73        nth1(N,List,What),
   74	What == [].
   75
   76pddl_idea(Agent,actMove(1,Dir)) :-
   77	mudGetPrecepts(Agent,List),
   78	list_object_dir_sensed(_,List,tUsefull,Dir).
   79
   80pddl_idea(Agent,actMove(1,Dir)) :-
   81	mudGetPrecepts(Agent,List),
   82	list_object_dir_sensed(_,List,tAgent,Dir).
   83
   84pddl_idea(Agent,actMove(5,Dir)) :-
   85	mudMemory(Agent,aDirectionsFn([Dir|_])),
   86	number_to_dir(Num,Dir,vHere),
   87	mudNearReach(Agent,List),
   88	nth1(Num,List,What),
   89	What == [].
   90
   91pddl_idea(Agent,actAttack(Dir)) :-
   92	mudNearReach(Agent,List),
   93	list_object_dir_near(List,mobMonster,Dir).
   94
   95pddl_idea(Agent,actLook) :-
   96        req1(mudMemory(Agent,aDirectionsFn(Old))),
   97	del(mudMemory(Agent,aDirectionsFn(Old))),
   98	random_permutation(Old,New),
   99	ain(mudMemory(Agent,aDirectionsFn(New))).
  100
  101
  102:- include(prologmud(mud_footer)).