1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
# An exit is an object that sits in one room and provides a link to
# another room. They typically come in pairs (so you can go back).
package Exit;
use Utils;
use strict;
use vars qw(@ISA);
use Thing;
use UNIVERSAL qw(isa);
@ISA=qw{Thing};
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $this = Thing::new($class,@_);
bless ($this, $class);
return $this;
}
# Move the calling object through to the room I'm linked to.
#
# As a special fetaure, you can type "go foo bar baz", and
# it will automatically run each of the go commands in sequence.
sub verb_go {
my $this=shift;
my $verbcall=shift;
if (! isa($this->destination,"Room")) {
return "You can't go there."
}
$verbcall->caller->tell($this->message);
$verbcall->caller->location->announce($verbcall->caller,$verbcall->caller->name." goes ".$this->name.".");
$verbcall->caller->location->contents_remove($verbcall->caller);
$this->destination->announce($verbcall->caller,$verbcall->caller->name." has arrived.");
$verbcall->caller->location($this->destination);
$verbcall->caller->location->contents_add($verbcall->caller);
# If this is a compound go command, things get ugly.
my ($v,@words)=$verbcall->words;
shift(@words);
if (@words && $words[0]) {
$verbcall->words($v,@words);
my $thing;
foreach $thing (@{$verbcall->caller->location->exits}) {
if ($thing && $thing->isalias($verbcall->word('direct_object'))) {
$verbcall->direct_object($thing);
$verbcall->object($thing);
my $sub=$thing->getverbsub($verbcall);
if (defined $sub) {
return $thing->$sub($verbcall);
}
}
}
# Well that failed - call the go verb on the room we're in
# as a last resort.
return $verbcall->caller->location->verb_go($verbcall);
}
return;
}
# A bit of sanity checking on destination setting.
sub destination {
my $this=shift;
if (@_) {
my $dest=shift;
if (! isa($dest,"Room")) {
Utils::Log("notice","Tried to link an exit to a non-room object.");
return Error->new("Cannot link an exit to a non-room object.");
}
return Thing::destination($this,$dest);
}
else {
return Thing::destination($this);
}
}
# Override the name method, because when the name of an exit is
# set, it sets a verb too.
sub name {
my $this=shift;
if (@_) {
my $name=shift;
if ($this->name ne undef) {
$this->removeverb($this->name);
}
if ($name ne undef) {
my @verbs=$this->listverbs;
$this->addverb(Verb->new(sub => 'verb_go',command => $name));
}
return Thing::name($this,$name);
}
else {
return Thing::name($this);
}
}
# Override the alias method, because when the alias of an exit is set,
# it sets a verb too.
sub aliases {
my $this=shift;
if (@_) {
my $value=shift;
# Remove all old verbs.
if (ref Thing::Aliases($this) eq 'ARRAY') {
my $alias;
foreach $alias (@{Thing::Aliases($this)}) {
$this->removeverb($alias);
}
}
# Set new aliases and verbs.
foreach (@$value) {
$this->addverb(Verb->new(sub => 'verb_go', command => $_));
}
return Thing::aliases($this,$value);
}
else {
return Thing::aliases($this);
}
}
1;
|
