1% eat.pl
    2% July 1, 1996
    3% John Eikenberry
    4%
    5% Dec 13, 2035
    6% Douglas Miles
    7%
    8/*
    9% This file defines the agents action of eating. 
   10% Very simple... but kept separate to maintain modularity
   11%
   12% This uses the worth/2 predicate from take.pl
   13% Will (theoretically) only be used in conjuction with take action
   14%
   15% It will destroy something, even if it is not food... talk about a garbage disposal. 
   16*/
   17
   18% :-swi_module(user). 
   19:-swi_module(modEat, []).   20
   21:- include(prologmud(mud_header)).   22
   23% :- register_module_type (mtCommand).
   24
   25genls(tFood,tEatAble).
   26baseKB:action_info(actEat(tEatAble),"nourish oneself").
   27
   28
   29agent_coerce_for(Pred,_TC,Agent,String,Obj):-
   30   \+ call(Pred,Agent,String),
   31      call(Pred,Agent,Obj),
   32      match_object(String,Obj).
   33
   34
   35% Eat something held
   36baseKB:agent_call_command(Agent,actEat(String)) :- 
   37      agent_coerce_for(mudPossess,tEatAble,Agent,String,Obj),!,
   38      baseKB:agent_call_command(Agent,actEat(Obj)).
   39
   40% Check to make sure it's in the agents possession... 
   41% if it is, process it's worth, then destroy it
   42baseKB:agent_call_command(Agent,actEat(Obj)) :-
   43  ((must_det((
   44	mudPossess(Agent,Obj),
   45	must((do_act_affect(Agent,actEat,Obj))),
   46        must((clr(mudStowing(Agent,Obj)))),
   47        % dmsg_show(_),
   48        destroy_instance(Obj),!,
   49        sanity(\+ (mudPossess(Agent,Obj))),
   50	must((call_update_charge(Agent,actEat))))))),!.
   51
   52update_charge(Agent,actEat) :- padd(Agent,mudEnergy(+ -1)).
   53
   54:- include(prologmud(mud_footer)).