gender utilities (#43)(an instance of Generic Utilities Package made by Hacker)     Defines the list of standard genders, the default pronouns for each, and routines for adding or setting pronoun properties on any gendered object.            Properties:       .genders -- list of standard genders       .pronouns -- list of pronoun properties       .ps .po .pp .pq .pr .psc .poc .ppc .pqc .prc       -- lists of pronouns for each of the standard genders             If foo is of gender this.gender[n],       then the default pronoun foo.p is this.p[n]       (where p is one of ps/po/pp/pq...)            Verbs:       :set(object,newgender) -- changes pronoun properties to match new gender.       :add(object[,perms[,owner]]) -- adds pronoun properties to object.             :get_pronoun (which,object) -- return pronoun for a given object       :get_conj*ugation(verbspec,object) -- return appropriately conjugated verb VERB SOURCE CODE: set:
"$gender_utils:set(object,gender) --- sets the pronoun properties of object.";
"gender is a string: one of the strings in $gender_utils.genders, the list of rcognized
genders. If the gender change is successful, the (full) name of the gender (e.g.,
\"male\") is returned. E_NONE is returned if gender does not match any recognized
gender. Any other error encountered (e.g., E_PERM, E_PROPNF) is likewise returned
and the object's pronoun properties are left unaltered.";
set_task_perms(caller_perms());
if (this == (object = args[1]))
return E_DIV;
elseif (gnum = $string_utils:find_prefix(gender = args[2], this.genders))
gender = this.genders[gnum];
else
return E_NONE;
endif
save = {};
prons = this.pronouns;
for p in (prons)
save = {@save, e = object.(p)};
if ((typeof(e) != STR) || (typeof(e = object.(p) = this.(p)[gnum]) == ERR))
for i in [1..length(save) - 1]
object.(prons[i]) = save[i];
endfor
return e;
endif
endfor
return gender;
.
add:
"$gender_utils:add(object[,perms[,owner]])";
"--- adds pronoun properties to object if they're not already there.";
" perms default to \"rc\", owner defaults to the object owner.";
set_task_perms(caller_perms());
object = args[1];
perms = (length(args) >= 2) ? args[2] | "rc";
owner = (length(args) >= 3) ? args[3] | object.owner;
prons = this.pronouns;
e = 1;
for p in (prons)
if (!$object_utils:has_property(object, p))
e = add_property(object, p, "", {owner, perms});
if (typeof(e) == ERR)
player:tell("Couldn't add ", object, ".", p, ": ", e);
return;
endif
elseif ((typeof(object.(p)) != STR) && (typeof(e = object.(p) = "") == ERR))
player:tell("Couldn't reset ", object, ".", p, ": ", e);
return;
elseif (!object.(p))
e = 0;
endif
endfor
if ((!e) && (ERR == typeof(e = this:set(object, "neuter"))))
player:tell("Couldn't initialize pronouns: ", e);
endif
.
get_pronoun:
"get_pronoun(key,object) => pronoun corresponding to object.";
"key can be one of s,o,p,q,r,S,O,P,Q,R to refer to the pronoun properties relatively
directly or it can be something of the form \"he/she\" or \"He/She\".";
"Next the object is checked for the desired pronoun property. If that doesn't exist,
we look at object.gender and infer the pronoun from the corresponding $gender_utils
property. If .gender doesn't exist or the object itself is invalid, we use the corresponding
property on $player.";
key = args[1];
if (key[1] == ":")
key = key[2..length(key)];
endif
if ((length(key) == 1) && (i = index("sopqrSOPQR", key, 1)))
prop = this.pronouns[i];
else
search = "$1:he$s:she$1:he/she$2:him$2:him/her$3:his/her$4:hers$4:his/hers$5:himself$5:herself$5:himself/herself";
i = index(search, (":" + key) + "$");
if (!i)
return "";
endif
cap = strcmp("a", key) > 0;
prop = this.pronouns[tonum(search[i - 1]) + (5 * cap)];
endif
if (!valid(object = (length(args) >= 2) ? args[2] | player))
return $player.(prop);
elseif (STR == typeof(p = object.(prop)))
return p;
elseif ((STR == typeof(g = object.gender)) && (i = g in this.genders))
return this.(prop)[i];
else
return $player.(prop);
endif
.
get_conj*ugation:
"get_conj(verbspec,object) => verb conjugated according to object.";
"verbspec can be one of \"singular/plural\", \"singular\", \"singular/\", or \"/plural\",
e.g., \"is/are\", \"is\", \"is/\", or \"/are\".";
"The object is checked to see whether it is singular or plural. This is inferred
from its .gender property. If .gender doesn't exist or the object itself is invalid,
we assume singular.";
spec = args[1];
i = index(spec + "/", "/");
sing = spec[1..i - 1];
if (i < length(spec))
plur = spec[i + 1..length(spec)];
else
plur = "";
endif
cap = strcmp("a", (i == 1) ? spec[2] | spec) > 0;
if (((valid(object = (length(args) >= 2) ? args[2] | player) && (STR == typeof(g
= object.gender))) && (i = g in this.genders)) && this.is_plural[i])
vb = plur || this:_verb_plural(sing, i);
else
vb = sing || this:_verb_singular(plur, i);
endif
if (cap)
return $string_utils:capitalize(vb);
else
return vb;
endif
.
_verb_plural:
if (typeof(st = args[1]) != STR)
return E_INVARG;
endif
len = length(st);
if ((len >= 3) && (rindex(st, "n't") == (len - 2)))
return this:_verb_plural(st[1..len - 3], args[2]) + "n't";
elseif (i = st in {"has", "is"})
return this.({"have", "be"}[i])[args[2]];
elseif (st == "was")
return (args[2] > 6) ? "were" | st;
elseif ((len <= 3) || (st[len] != "s"))
return st;
elseif (st[len - 1] != "e")
return st[1..len - 1];
elseif ((r = rindex(st, "sses") || rindex(st, "zzes")) && (r == (len - 3)))
return st[1..len - 3];
elseif (((st[len - 2] == "h") && index("cs", st[len - 3])) || index("ox", st[len
- 2]))
return st[1..len - 2];
"washes => wash, belches => belch, boxes => box";
"used to have || ((st[len - 2] == \"s\") && (!index(\"aeiouy\", st[len - 3])))";
"so that
_verb_singular:
if (typeof(st = args[1]) != STR)
return E_INVARG;
endif
len = length(st);
if ((len >= 3) && (rindex(st, "n't") == (len - 2)))
return this:_verb_singular(st[1..len - 3], args[2]) + "n't";
elseif (i = st in {"have", "are"})
return this.({"have", "be"}[i])[args[2]];
elseif ((st[len] == "y") && (!index("aeiou", st[len - 1])))
return st[1..len - 1] + "ies";
elseif (index("sz", st[len]) && index("aeiou", st[len - 1]))
return (st + st[len]) + "es";
elseif (index("osx", st[len]) || ((len > 1) && (index("chsh", st[len - 1..len]) %
2)))
return st + "es";
else
return st + "s";
endif
.
_do:
"_do(cap,object,modifiers...)";
cap = args[1];
object = args[2];
if (!(modifiers = args[3]))
if (typeof(object) != OBJ)
return tostr(object);
elseif (!valid(object))
return (cap ? "N" | "n") + "othing";
else
return cap ? object:titlec() | object:title();
endif
elseif (modifiers[1] == ".")
len = length(modifiers);
if (i = index(modifiers[2..len], "."))
i = i + 1;
elseif (!(i = (index(modifiers, ":") || index(modifiers, "#")) || index(modifiers,
"!")))
i = len + 1;
endif
if (typeof(o = object.(modifiers[2..i - 1])) == ERR)
return tostr("%(", o, ")");
else
return this:_do(cap || (strcmp("a", modifiers[2]) > 0), o, modifiers[i..len]);
endif
elseif (modifiers[1] == ":")
if (typeof(object) != OBJ)
return tostr("%(", E_TYPE, ")");
elseif (p = this:get_pronoun(modifiers, object))
return p;
else
return tostr("%(", modifiers, "??)");
endif
elseif (modifiers[1] == "#")
return tostr(object);
elseif (modifiers[1] == "!")
return this:get_conj(modifiers[2..length(modifiers)], object);
else
i = (((index(modifiers, ".") || index(modifiers, ":")) || index(modifiers, "#"))
|| index(modifiers, "!")) || (length(modifiers) + 1);
s = modifiers[1..i - 1];
if (j = s in {"dobj", "iobj", "this"})
return this:_do(cap, {dobj, iobj, callers()[2][1]}[j], modifiers[i..length(modifiers)]);
else
return tostr("%(", s, "??)");
endif
endif
.
pronoun_sub:
"Experimental pronoun substitution. The official version is on $string_utils.";
"syntax: :pronoun_sub(text[,who])";
"experimental version that accomodates Aladdin's style...";
set_task_perms($no_one);
who = (length(args) >= 2) ? args[2] | player;
if (typeof(args[1]) == LIST)
plines = {};
for line in (args[1])
plines = {@plines, this:pronoun_sub(line, who)};
endfor
return plines;
endif
old = tostr(args[1]);
new = "";
here = valid(who) ? who.location | $nothing;
objspec = "nditl";
objects = {who, dobj, iobj, caller, here};
prnspec = "sopqrSOPQR";
prprops = {"ps", "po", "pp", "pq", "pr", "Ps", "Po", "Pp", "Pq", "Pr"};
oldlen = length(old);
while ((prcnt = index(old, "%")) && (prcnt < oldlen))
cp_args = {};
s = old[k = prcnt + 1];
if (brace = index("([{", s))
if (!(w = index(old[k + 1..oldlen], ")]}"[brace])))
return new + old;
elseif (brace == 3)
s = this:_do(0, who, old[prcnt + 2..(k = k + w) - 1]);
else
p = old[prcnt + 2..(k = k + w) - 1];
if (brace == 1)
cp_args = {who, p};
elseif (p[1] == "#")
s = (o = index(objspec, p[2])) ? tostr(objects[o]) | (("[" + p) +
"]");
elseif (!(o = index(objspec, p[1])))
s = ("[" + p) + "]";
else
cp_args = {objects[o], p[2..w - 1], strcmp(p[1], "a") < 0};
endif
endif
elseif (o = index(objspec, s))
cp_args = {objects[o], "", strcmp(s, "a") < 0};
elseif (w = index(prnspec, s, 1))
cp_args = {who, prprops[w]};
elseif (s == "#")
s = tostr(who);
elseif (s != "%")
s = "%" + s;
endif
new = (new + old[1..prcnt - 1]) + ((!cp_args) ? s | ((typeof(sub = $string_utils:_cap_property(@cp_args))
!= ERR) ? sub | (("%(" + tostr(sub)) + ")")));
old = old[k + 1..oldlen];
oldlen = oldlen - k;
endwhile
return new + old;
.
PROPERTY DATA:       is_plural       have       be       pronouns       genders       ps       po       pp       pq       pr       psc       poc       ppc       pqc       prc |