A dump of #52766 (Equipment Dispenser)

@create $thing named GM Equipment Dispenser:GM Equipment Dispenser,GMED,Grabber,unlicensed particle accelerator
@prop #52766."dispenses" {} rc
;;#52766.("dispenses") = {#1247, #2138, #457, #20864, #20865, #283, #76, #155, #243, #1660, #331, #2231, #1454, #1394, #154, #3791, #159, #370, #3089, #4038, #8751, #10902, #20769, #20868, #4318, #8833, #8909, #9350, #21543, #20847, #43337, #38579, #38584, #40308, #40305, #5506, #47326, #20253, #52610, #58135, #58137, #42517, #21564, #4878, #53156, #51818, #64134, #11636, #45865, #22841, #52728, #60226, #60608, #69882, #52618, #1804, #28065, #16268, #11901, #60126, #26790, #60614, #37646, #73064, #38427, #60590, #58725, #4399, #84829, #978, #7439, #75686, #4100, #11312, #87471, #2895, #26994, #101305, #65042, #11332, #85875, #77953, #13557, #437, #79903, #99588, #93776, #65063, #2061, #66228, #66229, #13947, #22272, #22276, #13940, #13950, #13944, #35976, #14579, #87306, #8169, #56319, #77202, #14282, #55016, #51879, #16609, #77297, #1511, #3533, #3303, #104057, #1723, #1722, #1764, #1765, #1766, #1265, #7775, #1325, #1920, #99908, #1053, #3277, #9511, #99354, #35169, #1770, #7015, #5892, #69056, #67470, #97530, #22618, #5277, #75317, #7385, #1197, #1252, #114120, #2423, #6838, #4297, #9023, #3528, #3863, #5570, #1868, #5109, #5012, #7714, #9662, #7695, #8252, #6871, #2571, #7905, #6571, #8948, #88919, #54610, #101242, #84168, #40580, #5364, #1231, #90527, #1032, #7709, #58931, #587, #1219, #1320, #7911, #4110, #9714, #4432, #6894, #94008, #422, #7491, #7581, #4471, #9139, #21331, #44096, #5604, #1357, #90498, #90044, #6276, #19959, #63893, #116539, #115169, #102014, #99526, #34028, #114455, #3836, #63044, #5625, #8336, #2686, #3395, #27714, #9173, #1927, #22227, #2267, #77111, #73777, #1484, #1508, #14444, #1061, #1483, #1532, #10601, #117772, #118881, #118884, #118886, #77337, #115550, #70303, #77877, #108557, #89482, #77977, #9698, #76260, #53021, #11760, #73452, #103732, #72086, #90160, #8912, #32051, #121187, #10260, #38852, #15904, #16993, #2401, #8806, #3804, #24166, #96770, #119789, #55075, #107867, #9167, #5658, #57581, #60254}
@prop #52766."vacuum" #10161 rc
@prop #52766."limit" {} rc
;;#52766.("limit") = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 99, 99, 99, 0, 99, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 25, 99, 99, 99, 0, 99, 0, 0, 0, 0, 0, 0, 0, 99, 0, 99, 0, 0, 0, 0, 0, 0, 0, 99, 150, 100, 49, 99, 0, 0, 0, 33, 99, 99, 125, 0, 0, 0, 0, 0, 0, 0, 80, 30, 35, 40, 50, 30, 0, 10, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 35, 0, 99, 99, 0, 0, 0, 0, 20, 0, 0, 0, 25, 0, 0, 0, 0, 0, 0, 25, 16, 16, 20, 0, 0, 0, 999, 20, 30, 99, 0, 99, 0, 0, 0, 6, 0, 99, 0, 0, 150, 0, 27, 25, 0, 0, 0, 0, 0, 0, 33, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, 55, 20, 20, 0, 6, 20, 0, 15, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 44, 0, 0, 0, 99, 0, 33, 7, 0, 0, 30, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 33, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 20, 0, 0, 15, 50, 0, 0, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 20, 99, 100}
@prop #52766."pearl_data" {} rc
;;#52766.("pearl_data") = {{"%color1", {"%color1", "pearl"}, "A %shape %luster pearl with a %color2 hue.  It is %size."}, {{"%color1", "%color2"}, {0, "grey pearl", "light gray"}, {50, "white pearl", "pure white"}, {200, "gold pearl", "pale gold"}, {250, "green pearl", "delicate green"}, {300, "pink pearl", "pretty pink"}, {350, "blue pearl", "lovely blue"}, {400, "black pearl", "pure black"}}, {{"%size"}, {0, "very tiny"}, {60, "quite small"}, {120, "average sized"}, {220, "rather large"}}, {{"%luster"}, {0, "dull"}, {70, "shiny"}, {140, "brilliantly lustrous"}}, {{"%shape"}, {0, "malformed"}, {30, "slightly lumpy"}, {50, "perfectly round"}}}
@prop #52766."gem_data" {} rc
;;#52766.("gem_data") = {{"%gem", {"%gem", "gem", "jewel"}, "A %size %color %comp.  This %opaque gem %process."}, {{"%gem", "%opaque", "%color", "%comp"}, {0, "azurite", "translucent", "blue", "copper carbonate gemstone"}, {40, "amber", "transparent", "yellow", "fossil resin gemstone"}, {80, "onyx", "translucent", "black", "quartz gemstone"}, {120, "carnelian", "transparent", "red", "quartz gemstone"}, {160, "opal", "translucent", "white", "hydrated silicon dioxide gemstone"}, {200, "turquoise", "opaque", "green-blue", "cuprous aluminate gemstone"}, {240, "topaz", "translucent", "yellow", "aluminum silicate gemstone"}, {280, "jade", "translucent", "green", "nephrite or jadeite gemstone"}, {320, "amethyst", "transparent", "purple", "corundum"}, {360, "garnet", "transparent", "pomegranate-red", "crystalline silicate gemstone"}, {400, "aquamarine", "transparent", "blue-green", "beryl"}, {440, "emerald", "transparent", "green", "beryl"}, {500, "sapphire", "translucent", "deep-blue", "corundum"}, {560, "ruby", "translucent", "deep-red", "corundum"}, {620, "diamond", "transparent", "blueish", "crystalline carbon gemstone"}}, {{"%size"}, {0, "rather small"}, {120, "medium sized"}, {300, "high carat-weight"}}, {{"%process"}, {0, "is uncut"}, {80, "has been cleaned but is still uncut"}, {160, "has been roughly cut to maximize convex volume"}, {240, "has been expertly cut and polished."}}}
"#52766.("distributor") => E_PERM (Permission denied)
"#52766.("key") => E_PERM (Permission denied)
;;#52766.("aliases") = {"GM Equipment Dispenser", "GMED", "Grabber", "unlicensed particle accelerator"}
;;#52766.("description") = "A facility through which Gamemasters can grab weapons directly, without having to walk to the Academy each time they wish to arm a monster.  Also a quick way to put non-traditional weapons into circulation."
;;#52766.("object_size") = {26666, 1141286561}

@verb #52766:"rem*ove_dispensed remove_dispenses" this none this
@program #52766:remove_dispensed
":rem_dispensed(OBJ parent_object) -- Removes the object from this.dispenses, so that it's kids are no longer available for grabbing.";
{item} = args;
if (l = item in this.dispenses)
  if (!(this:may_edit(caller_perms()) || (item.owner == caller_perms())))
    return E_PERM;
  else
    this.dispenses = listdelete(this.dispenses, l);
    this.limit = listdelete(this.limit, l);
    this.distributor = listdelete(this.distributor, l);
  endif
endif
"Profane (#30788) - Fri Feb 15, 2002 - let gms remove their own crap";
.

@verb #52766:"add*_dispensed add_dispenses" this none this
@program #52766:add_dispensed
":add_dispensed(OBJ parent_object, [NUM limit, [OBJ distributor_object]]) -- Adds the object to this.dispenses, making its children available for grabbing.";
"Limit defaults to 0 (no limit), and limits the total number of objects that may be grabbed.";
{what, ?limit = 0, ?distributor = $nothing} = args;
if (!this:may_edit(caller_perms()))
  return E_PERM;
else
  if (valid(thing = toobj(what)))
    if (!(thing in this.dispenses))
      this.dispenses = listappend(this.dispenses, thing);
      this.limit = listappend(this.limit, limit);
      this.distributor = listappend(this.distributor, distributor);
    endif
  endif
  return thing in this.dispenses;
endif
.

@verb #52766:"may_edit" this none this
@program #52766:may_edit
":may_edit(OBJ caller_perms) => True if given player can modify properties on this object.";
return $local.rpg:is_grandmaster(args[1]);
.

@verb #52766:"match_dispensed" this none this
@program #52766:match_dispensed
":match_dispensed(STR|OBJ what)";
available = this.dispenses;
if (typeof(target = args[1]) == OBJ)
  return (target in available) ? target | ((parent(target) in available) ? parent(target) | $failed_match);
elseif (possibles = $match_utils:match_list(target, available))
  return possibles[1];
else
  return $failed_match;
endif
.

@verb #52766:"destroy" this none this
@program #52766:destroy
":destroy(equipment) => result -- Destroys killable RPG equipment.";
if (!$local.rpg:trusted(caller_perms()))
  return E_PERM;
elseif (!this.vacuum:killable(args[1]))
  return E_NACC;
else
  return $local.rpg.recycler:_recycle(@args);
endif
.

@verb #52766:"create" this none this
@program #52766:create
":create(item) => A kid of given item.  Calls :make_fertile just in case.";
{what, @extra} = args;
if (caller != this)
  return E_PERM;
else
  rpg = $local.rpg;
  if (what.owner != this.owner)
    `what:make_fertile() ! ANY';
  endif
  r = rpg.recycler:_create(@args);
  `what:make_fertile(1) ! ANY';
  return r;
endif
"Mooshie (#106469) - Mon Nov 17 06:35:34 1997 PST - Updated a bit, and added the new :make_fertile patch.";
.

@verb #52766:"set_limit" this none this
@program #52766:set_limit
":set_limit(OBJ dispensed object, NUM limit) -- sets how many TOTAL of a certain item may be grabbed via the grabber.";
if (!this:may_edit(caller_perms()))
  return E_PERM;
elseif (!$recycler:valid(what = this:match_dispensed(args[1])))
  return E_INVARG;
else
  return this.limit[what in this.dispenses] = tonum(args[2]);
endif
.

@verb #52766:"get_limit" this none this
@program #52766:get_limit
":get_limit(OBJ thing) => NUM number of things allowed to be created.";
if ((!args) || (!valid(what = this:match_dispensed(args[1]))))
  return E_INVARG;
else
  l = this.limit[what in this.dispenses];
  return (l == 0) ? $maxint | l;
endif
.

@verb #52766:"gem jewel pearl" this none this
@program #52766:gem
"(verb)(<value>, <towhere>) => random pearl, with value <value> goes <towhere>";
"The following data structure for 'info', or the default gem/pearl data structures would allow creation of any other generic gems we should want or anything else, for that matter.";
"{{<name>, <aliases>, <desc>}, [{{[<sub for>]*}, [{<min>, [<sub in>]*}]*}]*}";
"<name> == STR, name of item, potentially with one or more possible subs in it.";
"<aliases> == LIST of STR, aliases, possibly with subs.";
"<desc> == STR, description, with subs if any.";
"A LIST of zero or more sub descriptions, each of which consists of the following:";
"    [<sub for>]* == One or more STR to replace in the above";
"    A list of one or more of the following:";
"    <min> == INT, minimum value for the sub in to show.";
"    [<sub in>]* == A number of STR equal to the length of <sub for>.  These will replace instances of <sub for> if <min> is greater than the unallocated value of the gem.";
"Example:  {{\"%color gem\", {\"%color gem\", \"gem\"}, \"A gem.  It is %color.\"}, {{\"%color\"}, {0, \"blue\"}, {100, \"red\"}, {200, \"green\"}}}";
"Obviously, to create a more interesting gem, you'd need a more complicated data structure.  See the default gem and pearl structures for better examples.";
rpg = $local.rpg;
$local.rpg:secure();
{value, ?dest = caller, ?info = 0, ?jewel = rpg.gem, ?jewel_maker = rpg.gem_dispenser} = args;
{stuff, @data} = info ? info | this.((verb == "pearl") ? "pearl_data" | "gem_data");
{name, aliases, desc} = stuff;
desc = $list_utils:random_element(desc) || desc;
total = value;
sub_list = {};
for item in (data)
  {sub_words, @choices} = item;
  r = random(total);
  total = max(total - r, 1);
  high = 0;
  for choice in (choices)
    {v, @words} = choice;
    if (v < r)
      high = words;
    endif
  endfor
  if (high)
    for sub in (sub_words)
      {d, @high} = high;
      sub_list = listappend(sub_list, {sub, d});
    endfor
  endif
endfor
for sub in (sub_list)
  {sub_for, sub_in} = sub;
  name = strsub(name, sub_for, sub_in);
  newaliases = {};
  for alias in (aliases)
    newaliases = setadd(newaliases, strsub(alias, sub_for, sub_in));
  endfor
  aliases = newaliases;
  desc = strsub(desc, sub_for, sub_in);
endfor
value = ((value > 999) && (dest in rpg.vacuum.monsters)) ? random(value) | value;
return jewel_maker:grab_gem(dest, value, name, aliases, desc);
"THX (#105941) - Sun Apr 29, 2001 - Put a soft limit on the value of gemstones created on critters.  If the requested value exceeds 1000 gold (!) then random(value) is used instead.";
.

@verb #52766:"g_m_grab" this none this
@program #52766:g_m_grab
if (caller_perms() in $local.rpg.grand_masters)
  return this:grab(@args);
else
  return E_PERM;
endif
.

@verb #52766:"distributor" this none this
@program #52766:distributor
{item} = args;
(rpg = $local.rpg):secure();
keeps = {};
{NSK, Moriah} = rpg.object_db.shopkeeper;
if (indx = item in this.dispenses)
  valid(t = this.distributor[indx]) && (keeps = {t});
endif
for t in (children(rpg.object_db.OBJ_dispenser[1]))
  if ((item in t.dispenses) && valid(t.location))
    keeps = setadd(keeps, t);
  endif
endfor
for t in (children(NSK))
  things = {};
  for s in (t.inventory_items)
    (typeof(s) == LIST) || (things = setadd(things, s));
  endfor
  if (item in things)
    keeps = setadd(keeps, t);
  endif
endfor
for t in (children(Moriah))
  if (item in $list_utils:slice(t.inventory, 1))
    keeps = setadd(keeps, t);
  endif
endfor
for t in (rpg.vacuum.monsters)
  (item in t.generic_equipment) && (keeps = setadd(keeps, t));
endfor
valid(caller) || player:tell($string_utils:nn(item), " is distributed by: ", $string_utils:nn(keeps));
return {item, keeps};
.

@verb #52766:"add_dispensed(old)" this none this
@program #52766:add_dispensed(old)
":add_dispensed(OBJ parent_object, [NUM limit]) -- Adds the object to this.dispenses, making its children available for grabbing.";
"Limit defaults to 0 (no limit), and limits the total number of objects that may be grabbed.";
if (!this:may_edit(caller_perms()))
  return E_PERM;
else
  if (valid(thing = toobj(args[1])))
    if (!(thing in this.dispenses))
      this.dispenses = listappend(this.dispenses, thing);
      this.limit = listappend(this.limit, (length(args) > 1) ? args[2] | 0);
    endif
  endif
  return thing in this.dispenses;
endif
.

@verb #52766:"remove_dispensed(old)" this none this
@program #52766:remove_dispensed(old)
":rem_dispensed(OBJ parent_object) -- Removes the object from this.dispenses, so that it's kids are no longer available for grabbing.";
if (!this:may_edit(caller_perms()))
  return E_PERM;
else
  for item in (args)
    this.dispenses = listdelete(this.dispenses, l = item in this.dispenses);
    this.limit = listdelete(this.limit, l);
  endfor
endif
.

@verb #52766:"set_distributor" this none this
@program #52766:set_distributor
":set_distributor(OBJ dispensed object, OBJ distributor) -- sets an OBJ set as the distributor of the dispensed object for bookkeeping purposes.";
{item, distributor} = args;
if (!this:may_edit(caller_perms()))
  return E_PERM;
elseif ((typeof(distributor) != OBJ) || (!$recycler:valid(what = this:match_dispensed(item))))
  return E_INVARG;
else
  return this.distributor[what in this.dispenses] = distributor;
endif
.

@verb #52766:"grab(old)" this none this
@program #52766:grab(old)
":grab(STR|OBJ parent[, OBJ recipient]) -- Grabs a weapon/armour with the given parent (as object or name), and moves it to `recipient' (which defaults to caller).";
" => E_PERM if a non-GM calls the verb";
" => $failed_match if the given object is not available";
" => $ambiguous_match if an ambiguous string-reference is given";
" => object number of item found if the `grab' was successful.";
(rpg = $local.rpg):secure();
{what, ?where = valid(caller) ? caller | caller_perms()} = args;
what = this:match_dispensed(what);
if ((!valid(what)) || (parent(what) == $garbage))
  return what;
elseif (`caller.owner != rpg.owner ! ANY' && (limit = this.limit[what in this.dispenses]))
  if (length(children(what)) >= limit)
    return E_QUOTA;
  endif
endif
new = this:create(what, @listdelete(args, 1));
if (valid(new) && (parent(new) != $garbage))
  new.name = what.name;
  new.aliases = what.aliases;
  what.unique && (new.unique = 0);
  new:moveto(where);
endif
return new;
"StarDancer 19-NOV-95 -- Dispenser will no longer produce unique items.";
"Profane 19-APR-96 2232EST -- Added support for limiting # of items.";
"THX1138 30-Nov-1997  -- Ok, hacked this so that the dispenser limits don't apply to Grand_Master Emself.  Primary Reason: The academy gives out some items when players train there ... some are limited.  G_M should be exempted.";
.

@verb #52766:"request grab" this none this
@program #52766:request
":grab(STR|OBJ parent[, OBJ recipient, NUM bulk]) -- Grabs a weapon/armour with the given parent (as object or name), and moves it to `recipient' (which defaults to caller). If `bulk' is supplied, it creates and moves that many copies.";
" => E_PERM if a non-GM calls the verb";
" => $failed_match if the given object is not available";
" => $ambiguous_match if an ambiguous string-reference is given";
" => object number of item found if the `grab' was successful.";
(rpg = $local.rpg):secure();
{what, ?where = valid(caller) ? caller | caller_perms(), ?bulk = 0} = args;
if (bulk)
  return this:grab_bulk(what, where, bulk);
endif
what = this:match_dispensed(what);
if ((!valid(what)) || (parent(what) == $garbage))
  return what;
elseif (`caller.owner != rpg.owner ! ANY' && (limit = this.limit[what in this.dispenses]))
  if (length(children(what)) >= limit)
    return E_QUOTA;
  endif
endif
return this:_grab(what, where);
"StarDancer 19-NOV-95 -- Dispenser will no longer produce unique items.";
"Profane 19-APR-96 2232EST -- Added support for limiting # of items.";
"THX1138 30-Nov-1997  -- Ok, hacked this so that the dispenser limits don't apply to Grand_Master Emself.  Primary Reason: The academy gives out some items when players train there ... some are limited.  G_M should be exempted.";
"Hydros (#106189) - Tues June 29, 2005 - Rewritten, adding a call to this:grab_bulk() to make shopkeeps quicker. Old code moved to this:grab(old).";
"                                      - Moved the grunt work of the verb to the newly defined :_grab(), for use with both this and :grab_bulk().";
.

@verb #52766:"grab_bulk" this none this
@program #52766:grab_bulk
"Called from this:grab().  Grabs several copies of an item at once, with a limit of 50.";
(rpg = $local.rpg):secure();
{what, where, bulk} = args;
what = this:match_dispensed(what);
newlist = {};
if ((!valid(what)) || (parent(what) == $garbage))
  return what;
elseif (typeof(bulk) != NUM)
  return E_TYPE;
elseif (bulk > 25)
  raise(E_QUOTA, "Be responsible.  That's too many objects.");
elseif (bulk < 0)
  raise(E_QUOTA, "Nothing less than zero, thanks.");
elseif (`caller.owner != rpg.owner ! ANY' && (limit = this.limit[what in this.dispenses]))
  if ((length(children(what)) >= limit) || ((length(children(what)) + bulk) > limit))
    return E_QUOTA;
  endif
endif
for x in [1..bulk]
  rpg:s_i_n();
  new = this:_grab(what, where);
  newlist = setadd(newlist, new);
endfor
return newlist;
"Hydros (#106189) - Tues June 29, 2005 - Added to make shopkeeps quicker.";
.

@verb #52766:"_grab" this none this
@program #52766:_grab
"The grunt work of :grab and :grab_bulk.";
if ((callers()[1][1] == this) && (callers()[1][2] in {"request", "grab", "grab_bulk"}))
  $local.rpg:secure();
  {what, where} = args;
  new = this:create(@args);
  if (valid(new) && (parent(new) != $garbage))
    new.name = what.name;
    new.aliases = what.aliases;
    what.unique && (new.unique = 0);
    new:moveto(where);
  endif
  return new;
endif
"Hydros (#106189) - Tues June 29, 2005 - Added to handle the grunt work for :grab and :grab_bulk, the only verbs that can call this.";
.

"***finished***