Generic Scorpion Player Class (#153)

     The Generic Scorpion Player Class (GSPC) implements some basic themely features for 
players on Dhalgren MOO.  "Scorpions" are members of youth gangs who wear holographic 
light shields (in Delaney's book).  Features include:
     
      - look notification
      - carried objects with worn_msgs are integrated into the player's desc.
      - movable_msg == NO makes player unmovable by others.
      - remote_see_msg == YES allows players not in the same room to look at you.

if ((player.location != this.location) && (this.remote_see_msg != "YES"))
    player:tell("You are too far away to see that player.");
    return;
endif
pass(@args);
if (player != this)
    this:tell("[", player.name, " looks in your direction!]");
endif
.

if ((player.location != this.location) && (this.remote_see_msg != "YES"))
    return "You are too far away to see this player.";
endif
desc = pass(@args);
if (worn = this:get_worn())
    wmsgs = "";
    for w in (worn)
        wmsgs = (wmsgs + "  ") + $string_utils:pronoun_sub(this:is_wearable(w), this, 
w);
    endfor
    if (typeof(desc) == STR)
        return desc + wmsgs;
    elseif (typeof(desc) == LIST)
        return {@desc, wmsgs[3..length(wmsgs)]};
    else
        return wmsgs;
    endif
else
    return desc;
endif
.

"Copied from generic player (#6):home by The_Mayor (#2) Sun Feb  6 17:47:03 1994 
EST";
"modifed to use the usual player teleport messages like @go or @join";
start = this.location;
if (start == this.home)
    player:tell("You're already home!");
    return;
elseif (typeof(this.home) != OBJ)
    player:tell("You've got a weird home, pal.  I've reset it to the default one.");
    this.home = $player_start;
elseif (!valid(this.home))
    player:tell("Oh no!  Your home's been recycled.  Time to look around for a new 
one.");
    this.home = $player_start;
endif
this:moveto(this.home);
if (!valid(start))
elseif (start == this.location)
    start:announce(player.name, " learns that you can never go home...");
else
    start:announce(player:oself_port_msg(this.home));
endif
if (this.location == this.home)
    if (msg = this:self_port_msg(this.home))
        player:tell(msg);
    endif
    this.location:announce(player:oself_arrive_msg(this.home));
elseif (this.location == start)
    player:tell("Either home doesn't want you, or you don't really want to go.");
else
    player:tell("Wait a minute!  This isn't your home...");
    if (valid(this.location))
        this.location:announce(player.name, " arrives, looking quite bewildered.");
    endif
endif
.

if ((player != this) && (this.movable_msg == "NO"))
    this:tell(player.name, " tried to move you.");
    player:tell(E_PERM);
else
    pass(@args);
endif
.

this.location:announce_all("(", argstr, ")");
.

"simply returns what's being worn. Children can customize";
return this.worn;
.

"given a list of objects, sets in .worn. Does check that they have a worn_msg associated, 
and remove those that don't. Returning the list of those that were successfully added 
so calling verbs can check discrepencies.";
"Does NOT add to existing .worn. Simply replaces it. Calling verbs should use :et_worn 
to get the list and modify, then call :set_worn";
if ((!$perm_utils:controls(caller_perms(), this)) && (caller != this))
    return E_PERM;
elseif (typeof(wornlist = args[1]) != LIST)
    return E_TYPE;
else
    for d in (wornlist)
        if (!this:is_wearable(d))
            wornlist = setremove(wornlist, d);
        endif
    endfor
    return this.worn = wornlist;
endif
.

if ($set_utils:intersection($list_utils:slice(callers(), 2), {"look_self", "description"}))
    return $set_utils:xor(this.contents, this:get_worn());
else
    return pass(@args);
endif
.

"Allows the player to put on an object. The object must have a .worn_msg or a :worn_msg.";
"This verb calls :pre_dress_efects before putting it on and :post_dress_effects afterwards 
on the object if it exists to display messages or whatever the object desires";
target = player:my_match_object(dobjstr);
if (!$command_utils:object_match_failed(target, dobjstr))
    if (!player:is_wearable(target))
        player:tell("You can't seem to put ", target.name, " on.");
    elseif (target in (wear_now = player:get_worn()))
        player:tell("You are already wearing ", target.name, ".");
    else
        if ($object_utils:has_callable_verb(target, "pre_dress_effects"))
            target:pre_dress_effects();
        else
            player:tell("You put on ", target:title(), ".");
        endif
        if (target.location != player)
            target:moveto(player);
        endif
        this:set_worn(setadd(wear_now, target));
        if ($object_utils:has_callable_verb(target, "post_dress_effects"))
            target:post_dress_effects();
        else
            player:room_announce(player:titlec(), " puts on ", target:title(), ".");
        endif
    endif
endif
.

return $code_utils:verb_or_property(args[1], "worn_msg");
.

"Allows the player to remove on an object s/he is wearing.";
"This verb calls :pre_undress_efects before removing it on and :post_undress_effects 
afterwards on the object if it exists to display messages or whatever the object 
desires";
target = player:my_match_object(dobjstr);
worn = player:get_worn();
target = valid(target) ? target | $string_utils:match(dobjstr, worn, {"name", "aliases"});
if (!$command_utils:object_match_failed(target, dobjstr))
    if (!(target in worn))
        player:tell("You aren't wearing ", target.name, ".");
    else
        if ($object_utils:has_callable_verb(target, "pre_undress_effects"))
            target:pre_undress_effects();
        else
            player:tell("You remove ", target:title(), ".");
        endif
        this:set_worn(setremove(worn, target));
        if ($object_utils:has_callable_verb(target, "post_undress_effects"))
            target:post_undress_effects();
        else
            player:room_announce(player:titlec(), " removes ", target:title(), ".");
        endif
    endif
endif
.

if ((target = args[1]) == caller)
    if (args[1] in (worn = this:get_worn()))
        if ($object_utils:has_callable_verb(target, "pre_undress_effects"))
            target:pre_undress_effects();
        else
            player:tell("You remove ", target:title(), ".");
        endif
        this:set_worn(setremove(worn, target));
        if ($object_utils:has_callable_verb(target, "post_undress_effects"))
            target:post_undress_effects();
        else
            player:room_announce(player:titlec(), " removes ", target:title(), ".");
        endif
    endif
endif
.

player:tell_lines(#406:text());
.

"Copied from Patroclus (#78):tell Sat Nov 19 01:51:28 1994 EST";
notify(this, tostr(@args));
.