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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
|
# A generic container. A container is any object that can hold other objects.
package Container;
use strict;
use vars qw(@ISA);
use Thing;
use Verb;
use UNIVERSAL qw(isa);
use Text;
use Error;
@ISA=qw{Thing};
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $this = Thing::new($class,@_);
bless ($this, $class);
return $this;
}
# Cleans up after a container is deleted
# Transfer all things it contained into the place where the container is located
sub remove {
my $this = shift;
my $loc = $this->location;
if ($loc) {
foreach (@{$this->contents}) {
$_->location($loc) if $_;
$loc->contents_add($_);
}
# now $this doesn't contain anything. should we do this with
# contents_remove instead?
$this->contents([]);
}
my $ret=Thing::remove($this);
return $ret if (Error::iserror($ret));
}
# Add a new thing to the container.
sub contents_add {
my $this=shift;
my $thing=shift;
if (! isa($thing,"Thing")) {
return Error->new("Tried to add something ($thing) that's not a valid object to a container.");
}
# Ask the object to move.
$thing->location($this) || return undef;
# TODO: duplicate object detection?
my @contents=@{$this->contents};
push @contents,$thing;
$this->contents(\@contents);
}
# Remove somthing from the container.
sub contents_remove {
my $this=shift;
my $thing=shift;
# This is a trifle expensive, but it doesn't happen too often.
# I did it this way rather than using a hash for the objects, becuase
# a hash is a lot of bother when you want to save objects on it.
my $t;
my @newcontents=();
foreach $t (@{$this->contents}) {
if ($thing != $t) {
push @newcontents,$t;
}
}
$this->contents(\@newcontents);
}
# Pass it an object, it will return true if said object is in this container.
sub contents_test {
my $this=shift;
my $object=shift;
my $thing=undef;
foreach $thing (@{$this->contents}) {
if ($thing == $object) {
return 1;
}
}
return undef;
}
# Look inside the container for an object.
sub verb_look_inside {
my $this=shift;
my $verbcall=shift;
# Figure out what is the direct object, looking at my contents.
my @objects=$verbcall->caller->find_object($verbcall->word('direct_object'),@{$this->contents});
if ($#objects > 0) {
# Use a question callback to figure out which object they
# meant. Note that this is a closure, so it can see @objects
# and $verbcall, etc.
$verbcall->caller->question_callback(sub {
my $newverbcall=shift;
if ($newverbcall->command =~ m/^(\d+)$/ &&
$newverbcall->command <= $#objects + 1) {
$verbcall->direct_object($objects[$newverbcall->command - 1]);
return $verbcall;
}
else {
return undef;
}
});
my $n=1;
return "Which \"".$verbcall->word('direct_object')."\" do you mean?",
sort(map("\t".$n++.". ".$_->name, @objects));
}
else {
$verbcall->direct_object(shift @objects);
}
if ($verbcall->direct_object) {
return $verbcall->direct_object->verb_look($verbcall);
}
else {
return "There is no \"".$verbcall->word('direct_object')."\" inside ".$this->name.".";
}
}
# Change this so we show the contents. Note that it takes a caller now,
# who is not shown on the list of contents. That's special to containers'
# look methods.
sub look {
my $this=shift;
return ($this->description,$this->listobjects(ActiveUser::getactive));
}
# Pretty-prints the contents of the container.
sub listobjects {
my $this=shift;
my $caller=shift;
# Generate a list the names of all the objects in the container.
my @names;
my $thing;
foreach $thing (@{$this->contents}) {
if ($thing && $thing != $caller) {
push @names, $thing->name;
}
}
# Pretty-print the list of all the ojects in the container.
if (@names) {
return Text::subst($this->filled_msg, {
name => $this->name,
list => Text::MakeList(@names),
});
}
else {
return Text::subst($this->empty_msg, {
name => $this->name,
});
}
}
# This is a hack. See README.programming for why I have to do this.
sub is_invalid_name {
return Thing::is_invalid_name(@_);
}
sub verb_rename {
return Thing::verb_rename(@_);
}
sub verb_help {
return Thing::verb_help(@_);
}
1
|
