1% attack.pl
    2% June 18, 1996
    3% John Eikenberry
    4% Dec 13, 2035
    5% Douglas Miles
    6%
    7/* * module * 
    8% This file defines the agents action of attacking. 
    9% Comments below document the basic idea.
   10%
   11*/
   12
   13% :-swi_module(user). 
   14% :-module(modAttack, []).
   15
   16:- include(prologmud(mud_header)).   17
   18% :- register_module_type (mtCommand).
   19
   20% attack joe ->translates-> attack nw
   21vtActionTemplate(actAttack(vtDirection)).
   22
   23% check to make sure the canonicalizer left the compound..
   24:- sanity(clause(baseKB:vtActionTemplate(actAttack(vtDirection)),true)).   25% instead of replacing with..
   26:- sanity( \+ clause(baseKB:vtActionTemplate(actAttack),true)).   27
   28
   29
   30baseKB:agent_call_command(Agent,actAttack(Dir)):- once(actAttack(Agent,Dir)).
   31
   32% Attack
   33% Successful Attack
   34actAttack(Agent,Dir) :-	
   35	from_dir_target(Agent,Dir,XXYY),
   36	mudAtLoc(What,XXYY),
   37	damage_foe(Agent,What,hit),
   38	call_update_charge(Agent,actAttack).
   39
   40% Destroy small objects (food, etc.)
   41actAttack(Agent,Dir) :-	
   42	from_dir_target(Agent,Dir,XXYY),
   43	mudAtLoc(What,XXYY),	
   44	props(What,mudWeight(Was)),
   45        Was =< 1,
   46	destroy_object_via_attack(XXYY,What),
   47	call_update_charge(Agent,actAttack).
   48
   49% Hit a big object... causes damage to agent attacking
   50actAttack(Agent,Dir) :-	
   51	from_dir_target(Agent,Dir,XXYY),
   52	mudAtLoc(What,XXYY),
   53	props(What,mudWeight(_)),
   54	call_update_stats(Agent,actBash),
   55	call_update_charge(Agent,actAttack).
   56
   57% Hit nothing (empty space)... causes a little damage
   58actAttack(Agent,Dir) :-
   59	from_dir_target(Agent,Dir,XXYY),
   60	not(mudAtLoc(_,XXYY)),
   61	call_update_stats(Agent,wiff),
   62	call_update_charge(Agent,actAttack).
   63
   64% Check to see if agent being attacked is carrying an 
   65% object which provides defence
   66check_for_defence(Agent,Def) :-
   67	findall(Poss,mudPossess(Agent,Poss),Inv),
   68	member(Obj,Inv),
   69	props(Obj,mudActAffect(_,mudArmor(Def))).
   70check_for_defence(_,0).
   71
   72% Check to see if attacking agent has a weapon
   73check_for_weapon(Agent,Wpn) :-
   74	findall(Poss,mudPossess(Agent,Poss),Inv),
   75        member(Obj,Inv),
   76        props(Obj,mudActAffect(_,mudAttack(Wpn))).
   77
   78check_for_weapon(_,0).
   79
   80destroy_object_via_attack(LOC,What) :-
   81	del(mudAtLoc(What,LOC)),
   82        destroy_instance(What),!.
   83
   84% Does damage to other agent
   85damage_foe(Agent,What,hit) :-
   86	del(mudHealth(What,OldDam)),
   87	mudStr(Agent,Str),
   88	check_for_defence(What,Def),
   89	BaseAtk is Str * 2,
   90	check_for_weapon(Agent,Wpn),
   91	Atk is (Wpn + BaseAtk),
   92	NewDam is (OldDam - (Atk - Def)),
   93	ain(mudHealth(What,NewDam)).
   94
   95:- if(baseKB:startup_option(datalog,sanity);baseKB:startup_option(clif,sanity)).   96:- must(prologBuiltin(damage_foe/3)).   97:- must(prologBuiltin(check_for_weapon/2)).   98
   99%prologBuiltin(upprop/1).
  100%prologBuiltin(upprop/2).
  101
  102:- endif.  103
  104
  105update_charge(A,B):-update_charge_0(A,B).
  106% Record keeping
  107update_charge_0(Agent,actAttack) :- upprop(Agent,mudEnergy(+ -5)).
  108
  109update_stats(A,B):-update_stats_0(A,B).
  110update_stats_0(Agent,actBash) :-  upprop(Agent,mudHealth(+ -2)),
  111	(add_cmdfailure(Agent,actBash)).
  112update_stats_0(Agent,wiff) :- 
  113	del(mudHealth(Agent,Old)),
  114	New is Old - 1,
  115	ain(mudHealth(Agent,New)),
  116	(add_cmdfailure(Agent,actBash)).
  117
  118:- include(prologmud(mud_footer)).