1/* * <module> 
    2% This file gives a common place where world effects 
    3% (such as carrying  shield or being drunk) are implemented
    4%
    5% Project LogicMoo: A MUD server written in Prolog
    6% Maintainer: Douglas Miles
    7% Dec 13, 2035
    8%
    9*/
   10% :-swi_module(world_effects,[]).
   11
   12:- include(prologmud(mud_header)).   13
   14prologHybrid(mudActAffect/3).
   15
   16% Used by eat.pl and take.pl
   17% Is the object worth anything (either scored points or charge)
   18% Score any points?
   19
   20
   21do_act_affect(Agent,Action,Obj) :-
   22	props(Obj,mudActAffect(Action,mudScore(S))),
   23	ain(mudScore(Agent,+S)),
   24	fail. % fail to check for charge too
   25% Charge up those batteries
   26do_act_affect(Agent,Action,Obj) :-
   27          props(Obj,mudActAffect(Action,mudEnergy(NRG))),
   28	req1(mudEnergy(Agent,Chg)),
   29	req1(mudStm(Agent,Stm)),
   30	predInstMax(Agent,mudEnergy,Max),
   31	(Chg + NRG) < (((Stm * 10) -20) + Max),
   32	ain(mudEnergy(Agent,+NRG)),
   33	fail. % fail to check for healing
   34% Heal
   35do_act_affect(Agent,Action,Obj) :-
   36           props(Obj,mudActAffect(Action,heal(Hl))),
   37	req1((mudHealth(Agent,Dam),
   38             mudStm(Agent,Stm),
   39             mudStr(Agent,Str))),
   40	req1(predInstMax(Agent,mudHealth,Max)),
   41	(Dam + Hl) < ((((Stm * 10) -20) + ((Str * 5) - 10)) + Max),
   42	ain(mudEnergy(Agent,+Hl)),
   43	!.
   44do_act_affect(_,_,_).
   45
   46
   47% Check to see if last action was successful or not
   48:-export(wasSuccess/2).   49%:-start_rtrace.
   50wasSuccess(Agent,What,YN) :- ((mudCmdFailure(Agent,What) -> YN=vFalse ; YN=vTrue)).
   51%:-stop_rtrace.
   52%:-prolog.
   53
   54:-export(add_cmdfailure/2).   55add_cmdfailure(Agent,What):-ain(mudCmdFailure(Agent,What)).
   56
   57% Initialize world.
   58% This keeps the old databases messing with new runs.
   59           
   60
   61:-dynamic(spawn_objects/1).   62
   63% Check to see if any of the objects should be placed in the world as it runs.
   64
   65:-export(call_update_charge/2).   66call_update_charge(Agent,What):- padd(Agent,mudLastCmdSuccess(What,vTrue)), doall(must(update_charge(Agent,What))),!.
   67
   68:-export(call_update_stats/2).   69call_update_stats(Agent,What):- padd(Agent,mudLastCmdSuccess(What,vTrue)), doall(must(update_stats(Agent,What))),!.
   70
   71set_stats(Agent,[]) :- set_stats(Agent,[mudStr(2),mudHeight(2),mudStm(2),mudSpd(2)]).
   72
   73set_stats(Agent,Traits) :-
   74        clr(stat_total(Agent,_)),
   75        ain(stat_total(Agent,0)),	
   76	forall(member(Trait,Traits),
   77	       ignore(catch(process_stats(Agent,Trait),E,dmsg(E:process_stats(Agent,Trait))))),
   78               ignore(catch(check_stat_total(Agent),E2,dmsg(E2:check_stat_total(Agent)))).
   79set_stats(Agent,Traits):-dmsg(warn(failed(set_stats(Agent,Traits)))).
   80
   81process_stats(Agent,mudStr(Y)) :-
   82	ain(mudStr(Agent,Y)),
   83	must((mudHealth(Agent,Dam),number(Dam)))->
   84	NewDam is (Dam + ((Y * 5) - 10)),
   85	ain(mudHealth(Agent,NewDam)),
   86	ain(stat_total(Agent,+Y)).
   87
   88process_stats(Agent,mudHeight(Ht)) :-
   89	ain(mudHeight(Agent,Ht)),
   90	ain(stat_total(Agent,+Ht)).
   91
   92process_stats(Agent,mudStm(Stm)) :-
   93	ain(mudStm(Agent,Stm)),
   94	req1(mudHealth(Agent,Dam)),
   95	NewDam is (((Stm * 10) - 20) + Dam),
   96	ain(mudHealth(Agent,NewDam)),
   97	req1(mudEnergy(Agent,NRG)),
   98	Charge is (((Stm * 10) - 20) + NRG),
   99	ain(mudEnergy(Agent,Charge)),
  100	ain(stat_total(Agent,+Stm)).
  101
  102process_stats(Agent,mudSpd(Spd)) :-
  103	ain(mudSpd(Agent,Spd)),
  104	ain(stat_total(Agent,+Spd)).
  105
  106process_stats(Agent,Stat) :- ain(props(Agent,[Stat])).
  107
  108check_stat_total(Agent) :-
  109	req1(stat_total(Agent,Total)),
  110	Total > 12,!,
  111	nl,
  112	write('Agent '),
  113	write(Agent),
  114	write(' has more than 12 points in their triats.'),
  115	nl,
  116	write('Exiting....'),
  117	nl,
  118	abort.
  119check_stat_total(_)