ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/commands.ext
(Generate patch)

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.20 by pippijn, Fri Mar 2 10:15:38 2007 UTC vs.
Revision 1.33 by pippijn, Fri Mar 2 15:09:05 2007 UTC

17 17
18 if (length $from) { 18 if (length $from) {
19 $item = $ob->find_best_object_match ($from) 19 $item = $ob->find_best_object_match ($from)
20 or return $ob->message ("rename: could not find a matching item to rename."); 20 or return $ob->message ("rename: could not find a matching item to rename.");
21 } else { 21 } else {
22 $item = $ob->find_marked_object () 22 $item = $ob->find_marked_object
23 or return $ob->message ("rename: no from name and no marked item found to rename."); 23 or return $ob->message ("rename: no from name and no marked item found to rename.");
24 } 24 }
25 25
26 $item->custom_name (length $to ? $to : undef); 26 $item->custom_name (length $to ? $to : undef);
27 27
87 $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE); 87 $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE);
88 88
89 1 89 1
90}; 90};
91 91
92cf::register_command body => sub {
93 my ($ob) = @_;
94
95 my @body_locations = ("in your range slot", "on your arm", "on your body", "on your head",
96 "around your neck", "in your skill slot", "on your finger", "around your shoulders",
97 "on your feet", "on your hands", "around your wrists", "around your waist");
98
99 # Too hard to try and make a header that lines everything up, so just
100 # give a description. (comment from C++)
101 $ob->reply (undef, "The first column is the name of the body location.");
102 $ob->reply (undef, "The second column is how many of those locations your body has.");
103 $ob->reply (undef, "The third column is how many slots in that location are available.");
104
105 for (0 .. scalar @body_locations - 1) {
106 $ob->reply (undef, (sprintf "%-30s %5d %5d", $body_locations[$_], $ob->body_info($_), $ob->body_used($_)))
107 if $ob->body_info($_) or $ob->body_used($_);
108 }
109
110 $ob->reply (undef, "You are not allowed to wear armor")
111 unless $ob->flag (cf::FLAG_USE_ARMOUR);
112 $ob->reply (undef, "You are not allowed to use weapons")
113 unless $ob->flag (cf::FLAG_USE_WEAPON);
114
115 1
116};
117
118cf::register_command mark => sub {
119 my ($pl, $arg) = @_;
120
121 if (length $arg) {
122 my $ob = $pl->find_best_object_match ($arg);
123
124 return $pl->reply (undef, "Could not find an object that matches $arg")
125 unless $ob;
126
127 $pl->contr->mark ($ob);
128 $pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title));
129 } else {
130 my $ob = $pl->find_marked_object;
131
132 $pl->reply (undef, $ob
133 ? (sprintf "%s %s * is marked.", $ob->name, $ob->title)
134 : "You have no marked object.");
135 }
136
137 1
138};
139
140cf::register_command who => sub {
141 my ($ob, $arg) = @_;
142
143 $ob->speed_left ($ob->speed_left - 0.25);
144
145 $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE);
146
147 1
148};
149
150for my $cmd ("run", "fire") {
151 my $oncmd = "${cmd}_on";
152 cf::register_command $cmd => sub {
153 my ($ob, $arg) = @_;
154
155 $ob->contr->$oncmd (1);
156
157 return $ob->reply (undef, "Can't $cmd into a non adjacent square.")
158 if $arg < 0 or $arg >= 9;
159
160 $ob->move ($arg);
161
162 1
163 };
164
165 cf::register_command "${cmd}_stop" => sub {
166 my ($ob) = @_;
167
168 $ob->contr->$oncmd (0);
169
170 1
171 };
172}
173
174cf::register_command mapinfo => sub {
175 my ($ob) = @_;
176
177 my $map = $ob->map
178 or return;
179 $ob->reply (undef, (sprintf "%s (%s) %s", $map->name, $map->path, $ob->region->longname));
180 $ob->reply (undef, (sprintf "players: %d difficulty: %d size: %d start: %dx%d timeout: %d",
181 $map->players, $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout))
182 if $ob->flag (cf::FLAG_WIZ);
183 $ob->reply (undef, $map->msg);
184
185 1
186};
187
188cf::register_command whereami => sub {
189 my ($ob) = @_;
190
191 my $reg = $ob->region;
192 $ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg));
193
194 1
195};
196
197sub _set_mode($$$@) {
198 my ($name, $ob, $arg, $slot, @choices) = @_;
199
200 my $oldmode = $ob->contr->$slot;
201
202 return $ob->reply (undef, "$name is set to $choices[$oldmode]")
203 unless $arg;
204
205 my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices
206 or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1;
207
208 $ob->contr->$slot ($idx);
209 $ob->reply (undef, "$name" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $choices[$ob->contr->$slot]);
210}
211
212cf::register_command applymode => sub {
213 my ($ob, $arg) = @_;
214
215 _set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
216
217 1
218};
219
220cf::register_command petmode => sub {
221 my ($ob, $arg) = @_;
222
223 _set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
224
225 1
226};
227
228cf::register_command usekeys => sub {
229 my ($ob, $arg) = @_;
230
231 _set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
232
233 1
234};
235
92cf::register_command afk => sub { 236cf::register_command afk => sub {
93 my ($ob, $arg) = @_; 237 my ($ob, $arg) = @_;
94 238
95 $ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1); 239 $ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
96 $ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK"); 240 $ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
241
242 1
243};
244
245cf::register_command sound => sub {
246 my ($ob, $arg) = @_;
247
248 $ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
249 $ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
250
251 1
97}; 252};
98 253
99cf::register_command brace => sub { 254cf::register_command brace => sub {
100 my ($ob, $arg) = @_; 255 my ($ob, $arg) = @_;
101 256
102 $ob->contr->braced ($ob->contr->braced ? 0 : 1); 257 $ob->contr->braced ($ob->contr->braced ? 0 : 1);
103 $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced."); 258 $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
259
260 1
261};
262
263cf::register_command 'output-count' => sub {
264 my ($ob, $arg) = @_;
265
266 return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
267 unless $arg > 0;
268
269 $ob->contr->outputs_count ($arg);
270 $ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
271
272 1
273};
274
275cf::register_command 'output-sync' => sub {
276 my ($ob, $arg) = @_;
277
278 return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync)
279 unless $arg > 0;
280
281 $ob->contr->outputs_sync ($arg);
282 $ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync);
283
284 1
104}; 285};
105 286
106# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to 287# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
107# some other level (which may also be 0), this does not get echoed, 288# some other level (which may also be 0), this does not get echoed,
108# but it does get set. 289# but it does get set.
115 296
116 return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.") 297 return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
117 if $arg =~ /^\d+$/ and $arg <= 100; 298 if $arg =~ /^\d+$/ and $arg <= 100;
118 299
119 $ob->reply (undef, "Incorrect parameters for wimpy: $arg"); 300 $ob->reply (undef, "Incorrect parameters for wimpy: $arg");
301
302 1
120}; 303};
121 304
122cf::register_command peaceful => sub { 305cf::register_command peaceful => sub {
123 my ($ob, $arg) = @_; 306 my ($ob, $arg) = @_;
124 307
127 ." if you want to become hostile or in temple of Valriel" 310 ." if you want to become hostile or in temple of Valriel"
128 ." if you want to become peaceful again."); 311 ." if you want to become peaceful again.");
129 312
130 #$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1); 313 #$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
131 #$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players."); 314 #$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
132};
133 315
316 1
317};
134 318
135cf::register_command rename => sub { 319cf::register_command rename => sub {
136 my ($ob, $arg) = @_; 320 my ($ob, $arg) = @_;
137 321
138 $ob->speed_left ($ob->speed_left - 0.25); 322 $ob->speed_left ($ob->speed_left - 0.25);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines