|
sub teleport {
# cheat command: move the player to a new location
my ($self, $where) = @_;
my $story = $self->story();
unless ($where) {
$story->write_text("Please tell me where you want to go.");
} else {
my $object_cache = $self->get_object_cache();
my @hits = $object_cache->find($where, "-room" => 1);
my @item_hits = $object_cache->find($where);
if (@hits > 1) {
# ambiguous destination
$story->write_text(sprintf 'Hmm, where you mean: %s?',
nice_list(sort map {$_->[1]} @hits));
} elsif (@hits == 1) {
# only one possible destination: proceed
my $room_id = $hits[0]->[0];
my $zo = $object_cache->get($room_id);
if ($zo->is_current_room()) {
# destination is the current room: be rude
$story->write_text($self->random_message(
TELEPORT_HERE_MESSAGES));
} else {
# move to the new room
$story->insert_obj($story->player_object(), $room_id);
# make the player a child of the new room object
$story->write_text($self->random_message(
TELEPORT_MESSAGES));
# print an appropriate message
$story->push_command("look");
# steal player's next turn to describe new location
}
} elsif (@item_hits == 1) {
# user has specified an item, not a room;
# try to teleport to the room with the item
my $in_a_room = 0;
my $item_id = $item_hits[0]->[0];
my $zo = $object_cache->get($item_id);
my $levels = 0;
my $last;
while (1) {
$last = $zo;
$zo = $zo->get_parent();
$levels++;
last unless defined $zo;
if ($object_cache->is_room($zo->object_id())) {
# aha: looks like a room; go there.
if ($levels == 1) {
# item is a top-level child of the room
$story->write_text($self->random_message(
TELEPORT_TO_ITEM_MESSAGES));
} else {
# item is probably inside something visible
my $desc = $last->print();
$story->write_text(sprintf "I think it's
around here somewhere; try the %s.", $$desc);
# describe item's toplevel container
}
$story->insert_obj($story->player_object(),
$zo->object_id);
$story->push_command("look");
# move the player and steal turn to look around
$in_a_room = 1;
last;
}
}
unless ($in_a_room) {
# can't determine parent (many objects are
# in limbo until something happens)
my $random = $object_cache->get_random("-room" => 1);
$story->write_text(sprintf "I don't know where
that is; how about the %s?", $$random);
}
} elsif (@item_hits > 1) {
# ambiguous item
$story->write_text(sprintf 'Hmm, which do you mean:
%s?',nice_list(sort map {$_->[1]} @item_hits));
} else {
# no clue at all
my $random = $object_cache->get_random("-room" => 1);
$story->write_text(sprintf "I don't know where that is;
how about the %s?", $$random);
}
}
}
|
|