1/* * module *
    2% climb.pl
    3% June 18, 1996
    4% John Eikenberry
    5%
    6% This file defines the agents action of climbing. 
    7% Comments below document the basic idea.
    8%
    9% Dec 13, 2035
   10% Douglas Miles
   11*/
   12% :-swi_module(user). 
   13%:-swi_module(modClimb, []).
   14
   15:- include(prologmud(mud_header)).   16
   17% :- register_module_type (mtCommand).
   18
   19can_move_into(_LOC,XXYY):-var(XXYY),!,fail.
   20can_move_into(_LOC,XXYY):-not(mudAtLoc(_,XXYY)),!.
   21can_move_into(_LOC,XXYY):-ground(XXYY).
   22
   23%:-start_rtrace.
   24%:-trace.
   25vtActionTemplate(actClimb(vtDirection)).
   26%:- quietly.
   27%:-stop_rtrace.
   28
   29
   30baseKB:agent_call_command(Agent,actClimb(Dir)):- once(actClimb(Agent,Dir)).
   31
   32% Climb - If there is nothing there to climb, move to location plus take some damage and loose charge 
   33actClimb(Agent,Dir) :-	
   34	mudAtLoc(Agent,LOC),
   35	from_dir_target(LOC,Dir,XXYY),
   36	can_move_into(LOC,XXYY),
   37	in_world_move(_,Agent,Dir),
   38	call_update_stats(Agent,trip),
   39	call_update_charge(Agent,actClimb).
   40
   41% Object is too high to climb, or it is another agent. 
   42actClimb(Agent,Dir) :-	
   43	\+ climbable(Agent,Dir),
   44	call_update_stats(Agent,pulled),
   45	call_update_charge(Agent,actClimb).
   46
   47% Successful climb
   48actClimb(Agent,Dir) :-	
   49	in_world_move(_,Agent,Dir),
   50	call_update_charge(Agent,actClimb).
   51
   52% Test to see if agent can climb the object
   53climbable(Agent,Dir) :-
   54	mudAtLoc(Agent,LOC),
   55	from_dir_target(LOC,Dir,XXYY),
   56	mudAtLoc(Obj,XXYY),
   57	props(Obj,mudHeight(ObjHt)), % If object is an agent, it will fail at this point
   58	mudHeightOnObj(Agent,AgHt),
   59	mudAtLoc(Obj2,LOC), prop_or(Obj2,mudHeight,0,Obj2Ht),
   60	ObjHt =< (AgHt + Obj2Ht),
   61	ObjHt > 1.
   62
   63%Record keeping
   64update_charge(Agent,actClimb) :- call(padd(Agent,mudEnergy(+ -5))).
   65
   66prologBuiltin(padd/2).
   67update_stats(Agent,trip) :-  padd(Agent,mudHealth(+ -3)).
   68
   69update_stats(Agent,pulled) :- call(padd(Agent,mudHealth(+ -2))),
   70	(add_cmdfailure(Agent,pulled)).
   71
   72
   73:- include(prologmud(mud_footer)).