1% :-swi_module(user). 
    2% 
    3% :-module(modCreate, [rez_to_inventory/3]).
    4/* A command to  ...
    5% charge(Agent,Chg) = charge (amount of charge agent has)
    6% health(Agent,Dam) = damage
    7% mudLastCmdSuccess(Agent,Action,Suc) = checks success of last action (actually checks the cmdfailure predicate)
    8% score(Agent,Scr) = score
    9% to do this.
   10% Douglas Miles 2014
   11*/
   12:- include(prologmud(mud_header)).   13
   14% :- register_module_type (mtCommand).
   15
   16
   17
   18% ====================================================
   19% item rez (to mudStowing inventory)
   20% ====================================================
   21
   22:-export(rez_to_inventory/3).   23rez_to_inventory(Agent,NameOrType,NewObj):-
   24  gensym('_rez',SS),
   25  call_u(must_det_l((
   26  locally(t_l:current_source_suffix(SS),show_call(createByNameMangle(NameOrType,NewObj,Clz))),
   27   padd(NewObj,authorWas(rez_to_inventory(Agent,NameOrType,NewObj,Clz))),
   28   ain(genls(Clz,tItem)),
   29   padd(Agent,mudStowing(NewObj)),
   30   find_and_call(add_missing_instance_defaults(NewObj)),
   31   call_u(mudStowing(Agent,NewObj)),
   32   ireq(t(mudStowing,Agent,NewObj)),
   33   ireq(t(mudPossess,Agent,NewObj)),
   34   call_u(mudPossess(Agent,NewObj))))).
   35
   36
   37baseKB:action_info(actRez(isOneOf([tCol,ftID,ftTerm])),"Rezes a new subclass of 'item' or clone of tObj of some NameOrType into mudStowing inventory").
   38
   39baseKB:agent_call_command(Agent,actRez(NameOrType)):- nonvar(NameOrType),
   40        must(find_and_call(rez_to_inventory(Agent,NameOrType,NewObj))),
   41        fmt([rezed,NameOrType,NewObj]).
   42
   43% ====================================================
   44% object/col creation
   45% ====================================================
   46baseKB:action_info(actCreate(ftListFn(ftTerm)), "Rezes a new 'tSpatialThing' or creates a new 'col' of some NameOrType and if it's an 'item' it will put in mudStowing inventory").
   47
   48baseKB:agent_call_command(Agent,actCreate(SWhat)):- with_all_dmsg(must_det(create_new_object(Agent,SWhat))).
   49
   50==> prologHybrid(authorWas(ftTerm,ftTerm)).
   51:- dynamic(current_pronoun/3).   52==> prologHybrid(current_pronoun(tAgent,ftString,ftTerm)).
   53
   54:-export(create_new_object/2).   55
   56create_new_object(Agent,[tCol,NameOfType|DefaultParams]):-!,create_new_type(Agent,[NameOfType|DefaultParams]).
   57
   58create_new_object(Agent,[NameOrType|Params]):-
   59   call_u(( create_meta(NameOrType,NewType,tSpatialThing,NewObj),
   60   assert_isa(NewObj,NewType),
   61   ain(genls(NewType,tItem)),
   62   padd(NewObj,authorWas(create_new_object(Agent,[NameOrType|Params]))),
   63   padd(Agent,current_pronoun("it",NewObj)),   
   64   getPropInfo(Agent,NewObj,Params,2,PropList),!,
   65   padd(NewObj,PropList),
   66   must((isa(NewObj,tItem),padd(Agent,mudStowing(NewObj)))),
   67   find_and_call(add_missing_instance_defaults(NewObj)))).
   68
   69:-export(create_new_type/2).   70create_new_type(Agent,[NewObj|DefaultParams]):-
   71   call_u((ain(tCol(NewObj)),
   72   padd(NewObj,authorWas(create_new_type(Agent,[NewObj|DefaultParams]))),
   73   padd(Agent,current_pronoun("it",NewObj)),
   74   getPropInfo(Agent,NewObj,DefaultParams,2,PropList),!,
   75   ain(typeProps(NewObj,PropList)))).
   76
   77
   78getPropInfo(_Agent,_NewName,PropsIn,N,[mudDescription(ftText(need,to,actParse,PropsIn,N))]).
   79
   80
   81
   82:- include(prologmud(mud_footer)).