1% :-swi_module(user). 
    2:-swi_module(modSit, []).    3/* * module * Agent Postures there and does nothing
    4% Agent will loose a bit of charge, but heal a bit of damage
    5% May 18, 1996
    6% John Eikenberry
    7% Douglas Miles 2014
    8
    9*/
   10:- include(prologmud(mud_header)).   11
   12% :- register_module_type (mtCommand).
   13
   14ttValueType(vtPosture).
   15
   16==>prologSingleValued(mudStance(tAgent,vtPosture),[prologHybrid,relationMostInstance(tAgent,vStand)]).
   17
   18prologHybrid(actSetsPosture(vtVerb,vtPosture)).
   19
   20vtPosture(vSit).
   21vtPosture(vStand).
   22vtPosture(vLay).
   23vtPosture(vSleep).
   24vtPosture(vKneel).
   25
   26% converts vtPosture:"vSleep" to Action vtVerb:"actSleep"
   27vtPosture(PostureState)/i_name(act,PostureState,Action) ==>
   28   actSetsPosture(Action,PostureState).
   29
   30actSetsPosture(Action,PostureState) ==>
   31   {DO=..[Action,tFurniture]}, 
   32  action_info_prefered(DO,txtConcatFn(PostureState, " on ", tFurniture)).
   33
   34actSetsPosture(Action,PostureState) ==> 
   35  action_info_prefered(Action,txtConcatFn("sets agent's stance to ",PostureState)).
   36
   37baseKB:action_info(A,I):-action_info_prefered(A,I).
   38
   39% Become PostureState on Something.
   40baseKB:agent_call_command(Agent,actOnto(Where,PostureState)):-
   41        fmt('agent ~w is now ~wing on ~w',[Agent,PostureState,Where]),
   42        padd(Agent,mudStance(PostureState)),
   43        padd(Agent,localityOfObject(Where)),
   44	call_update_charge(Agent,PostureState).
   45
   46% PostureState Action Direct
   47baseKB:agent_call_command(Agent,Action):- callable(Action),
   48     functor(Action,Act,_),
   49     actSetsPosture(Act,PostureState),
   50     (compound(Action)->arg(1,Action,Where);Where=vHere),
   51     baseKB:agent_call_command(Agent,actOnto(Where,PostureState)).
   52
   53
   54update_charge(Agent,PostureState) :- vtPosture(PostureState), padd(Agent,mudEnergy(+ -1)).
   55
   56:- include(prologmud(mud_footer)).