1% :-swi_module(user). 
    2% :- module(modStats, []).
    3/* * module * A command to  ...
    4% charge(Agent,Chg) = charge (amount of charge agent has)
    5% health(Agent,Dam) = damage
    6% wasSuccess(Agent,_What,Suc) = checks success of last action (actually checks the cmdfailure predicate)
    7% score(Agent,Scr) = score
    8% to do this.
    9% Douglas Miles 2014
   10*/
   11:- include(prologmud(mud_header)).   12
   13% :- register_module_type (mtCommand).
   14
   15% ====================================================
   16% show the stats system
   17% ====================================================
   18baseKB:action_info(actStats(isOptional(tObj,isSelfAgent)), "Examine MUD stats of something").
   19
   20tCol(rtStatPred).
   21
   22==> 
   23rtStatPred(isEach(
   24         mudEnergy,
   25         mudStr,
   26         mudStm, % stamina
   27         mudScore,
   28         mudHealth,
   29         mudHeight)).
   30
   31
   32baseKB:agent_call_command(Agent,actStats(What)):-
   33  findall(Pred, (rtStatPred(Stat),Pred=..[Stat,What,value]),Stats),
   34   sort(Stats,StatsS),
   35   show_kb_preds(Agent,What,StatsS),!.
   36   %xlisting(What),!.
   37
   38
   39
   40/*
   41There are 7 aptitudes in Eclipse Phase:
   42* * Cognition (COG) is your aptitude for problemsolving,
   43logical analysis, and understanding. It
   44also includes memory and recall.
   45
   46* * Coordination (COO) is your skill at integrating
   47the actions of different parts of your morph
   48to produce smooth, successful movements. It
   49includes manual dexterity, fine motor control,
   50nimbleness, and balance.
   51* * Intuition (INT) is your skill at following your
   52gut instincts and evaluating on the fly. It includes
   53physical awareness, cleverness, and cunning.
   54* * Reflexes (REF) is your skill at acting quickly. This
   55encompasses your reaction time, your gut-level
   56response, and your ability to think fast.
   57* * Savvy (SAV) is your mental adaptability, social
   58intuition, and proficiency for interacting
   59with others. It includes social awareness and
   60manipulation.
   61* * Somatics (SOM) is your skill at pushing your
   62morph to the best of its physical ability, including
   63the fundamental utilization of the morph�s strength,
   64endurance, and sustained positioning and motion.
   65* * Willpower (WIL) is your skill for self-control,
   66your ability to command your own destiny.
   67*/
   68
   69baseKB:action_info(actGrep(isOptional(ftTerm,isSelfAgent)), "Examine MUD listing of something").
   70baseKB:agent_call_command(_Gent,actGrep(Obj)):- string(Obj),!,xlisting(Obj),atom_string(Atom,Obj),xlisting(Atom).
   71baseKB:agent_call_command(_Gent,actGrep(Obj)):- xlisting(Obj).
   72
   73:- include(prologmud(mud_footer)).