1% push.pl
    2% July 1, 1996
    3% John Eikenberry
    4%
    5% Dec 13, 2035
    6% Douglas Miles
    7%
    8/* * module * 
    9% This is meant to be used as a basic template for how the action
   10% files are formatted.
   11%
   12*/
   13% :-swi_module(user). 
   14:-swi_module(modPush, []).   15
   16:- include(prologmud(mud_header)).   17
   18% :- register_module_type (mtCommand).
   19
   20vtActionTemplate(actPush(vtDirection)).
   21
   22baseKB:agent_call_command(Agent,actPush(Dir)):-once(actPush(Agent,Dir)).
   23
   24% Push a box
   25% Nothing to push... agent moves and takes a little damage.
   26%Plus it still costs the same charge as if the agent did push something
   27actPush(Agent,Dir) :-	
   28	mudAtLoc(Agent,LOC),
   29	from_dir_target(LOC,Dir,XXYY),
   30	mudAtLoc(What,XXYY),
   31	integer(What),
   32	in_world_move(_,Agent,Dir),
   33	call_update_stats(Agent,strain),
   34	call_update_charge(Agent,actPush).
   35
   36% Pushing what cannot be pushed
   37% Some damage and loss of charge (same as normal push)
   38actPush(Agent,Dir) :-	
   39	mudAtLoc(Agent,LOC),
   40	from_dir_target(LOC,Dir,XXYY),
   41	mudAtLoc(What,XXYY),
   42	\+ pushable(Agent,What,XXYY,Dir),
   43	call_update_stats(Agent,hernia),
   44	call_update_charge(Agent,actPush).
   45
   46% A successful PUSH
   47actPush(Agent,Dir) :-	
   48	mudAtLoc(Agent,LOC),
   49	from_dir_target(LOC,Dir,XXYY),
   50	mudAtLoc(What,XXYY),
   51	move_object(XXYY,What,Dir),
   52	in_world_move(_,Agent,Dir),
   53	call_update_charge(Agent,actPush).
   54
   55% Can the Object be pushed?
   56pushable(Agent,Obj,LOC,Dir) :-
   57	mudStr(Agent,Str),
   58	props(Obj,mudWeight(Wt)),
   59	Wt \== 4,
   60	Wt =< Str,
   61	\+ anything_behind(LOC,Dir).
   62% If the Obj is another agent, compare strenghts to see if the agent can push the other
   63% An agent can push another if the agents strenght is greater that or equal to
   64% their opponents strength.
   65pushable(Agent,Obj,LOC,Dir) :-
   66	mudStr(Agent,Str),
   67	mudStr(Obj,OppStr),
   68	Str >= OppStr,
   69	(\+ anything_behind(LOC,Dir);
   70	crashbang(Obj)).
   71
   72% Is the location behind the pushed item/agent empty (or near empty).
   73anything_behind(LOC,Dir) :-
   74	from_dir_target(LOC,Dir,XXYY),
   75	mudAtLoc(What,XXYY),
   76	props(What,[mudWeight > 1,mudPermanence(actTake,or(Pm,0))]),
   77	Pm < 2.
   78
   79% Move the object.
   80move_object(LOC,Obj,Dir) :-
   81	from_dir_target(LOC,Dir,XXYY),
   82	squish_behind(XXYY,Obj),
   83	in_world_move(LOC,Obj,Dir).
   84
   85% Squish small objects behind what is being pushed.
   86squish_behind(LOC,Obj) :-
   87        XY = LOC,
   88	mudAtLoc(What,XY),
   89	props(What,mudWeight(1)),
   90	props(Obj,mudWeight(N)),
   91	N > 1,
   92	del(mudAtLoc(What,XY)).
   93squish_behind(_,_).
   94
   95% When one agent pushes another into a wall (or anything big), 
   96% both the agents take damage. 
   97% The pusher takes damage as normal (for pushing something
   98% unpushable), the pushy takes damage below
   99crashbang(Obj) :- padd(Obj,[mudHealth(+ -5)]).
  100
  101% Record keeping
  102update_charge(Agent,actPush) :- padd(Agent,[mudEnergy(+ -6)]).
  103update_stats(Agent,strain) :- padd(Agent,[mudHealth(+ -2)]).
  104update_stats(Agent,hernia) :- padd(Agent,[mudHealth(+ -4),mudCmdFailure(hernia)]).
  105
  106:- include(prologmud(mud_footer)).