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.11 by root, Tue Jan 2 19:18:33 2007 UTC vs.
Revision 1.26 by pippijn, Fri Mar 2 11:23:17 2007 UTC

… …
5# miscellaneous commands 5# miscellaneous commands
6 6
7sub rename_to($$$) { 7sub rename_to($$$) {
8 my ($ob, $from, $to) = @_; 8 my ($ob, $from, $to) = @_;
9 9
10 $to =~ /^[a-zA-Z0-9.,=#\/%$!^]*$/ 10 $to =~ /^[a-zA-Z0-9.,=#\/%$!^ ]*$/
11 or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things."); 11 or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things.");
12 12
13 127 >= length $to 13 127 >= length $to
14 or return $ob->message ("rename: new name must be <= 127 characters."); 14 or return $ob->message ("rename: new name must be <= 127 characters.");
15 15
… …
68 "* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title) 68 "* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
69 . ($pl->peaceful ? " [peaceful]" : " [HOSTILE]") 69 . ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
70 . ($ns->afk ? " [AFK]" : "") 70 . ($ns->afk ? " [AFK]" : "")
71 . ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "") 71 . ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
72 . " [" . $pl->ns->version . "]" 72 . " [" . $pl->ns->version . "]"
73 . " [" . ($pl->peaceful || $privileged ? $ob->map->{path}->visible_name : $ob->map->region ? $ob->map->region->name : "the unknown") . "]" 73 . " [" . ($pl->peaceful || $privileged ? $ob->map->visible_name : $ob->region->name) . "]"
74 . (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6) 74 . (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6)
75 . ($privileged ? " " . $pl->ns->host : "") 75 . ($privileged ? " " . $pl->ns->host : "")
76 } sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl 76 } sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
77 ), 77 ),
78 eval { "* IRC: " . join ", ", ext::schmorp_irc::users }, 78 eval { "* IRC: " . join ", ", ext::schmorp_irc::users },
… …
83 my ($ob, $arg) = @_; 83 my ($ob, $arg) = @_;
84 84
85 $ob->speed_left ($ob->speed_left - 0.25); 85 $ob->speed_left ($ob->speed_left - 0.25);
86 86
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
89 1
90};
91
92cf::register_command mapinfo => sub {
93 my ($ob) = @_;
94
95 my $map = $ob->map
96 or return;
97 $ob->reply (undef, (sprintf "%s (%s) %s", $map->name, $map->path, $ob->region->longname));
98 $ob->reply (undef, (sprintf "players: %d difficulty: %d size: %d start: %dx%d timeout: %d",
99 $map->players, $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout))
100 if $ob->flag (cf::FLAG_WIZ);
101 $ob->reply (undef, $map->msg);
102
103 1
104};
105
106cf::register_command whereami => sub {
107 my ($ob) = @_;
108
109 my $reg = $ob->region;
110 $ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg));
111
112 1
113};
114
115cf::register_command applymode => sub {
116 my ($ob, $arg) = @_;
117 my @types = ("nochoice", "never", "always");
118 my $mapping = {
119 nochoice => 1,
120 never => 2,
121 always => 3,
122 };
123
124 my $oldmode = $ob->contr->unapply;
125 my $oldmode_name = $types[$oldmode];
126
127 return $ob->reply (undef, "applymode is set to $oldmode_name")
128 unless $arg;
129
130 return $ob->reply (undef, "applymode: Unknown options '$arg', valid options are @types")
131 unless $mapping->{$arg};
132
133 $ob->contr->unapply ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
134 # but $arg would be 0 if a user enters an incorrect value
135 $ob->reply (undef, "applymode" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $types[$ob->contr->unapply]);
136
137 1
138};
139
140cf::register_command petmode => sub {
141 my ($ob, $arg) = @_;
142 my @types = ("normal", "sad", "defend", "arena");
143 my $mapping = {
144 normal => 1,
145 sad => 2,
146 defend => 3,
147 arena => 4,
148 };
149
150 my $oldtype = $ob->contr->petmode;
151 my $oldtype_name = $types[$oldtype];
152
153 return $ob->reply (undef, "petmode is set to $oldtype_name")
154 unless $arg;
155
156 return $ob->reply (undef, "petmode: Unknown options '$arg', valid options are @types")
157 unless $mapping->{$arg};
158
159 $ob->contr->petmode ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
160 # but $arg would be 0 if a user enters an incorrect value
161 $ob->reply (undef, "petmode" . ($oldtype == $ob->contr->petmode ? "" : " now") . " set to " . $types[$ob->contr->petmode]);
162
163 1
164};
165
166cf::register_command usekeys => sub {
167 my ($ob, $arg) = @_;
168 my @types = ("inventory", "keyrings", "containers");
169 my $mapping = {
170 inventory => 1,
171 keyrings => 2,
172 containers => 3,
173 };
174
175 my $oldtype = $ob->contr->usekeys;
176 my $oldtype_name = $types[$oldtype];
177
178 return $ob->reply (undef, "usekeys is set to $oldtype_name")
179 unless $arg;
180
181 return $ob->reply (undef, "usekeys: Unknown options '$arg', valid options are @types")
182 unless $mapping->{$arg};
183
184 $ob->contr->usekeys ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
185 # but $arg would be 0 if a user enters an incorrect value
186 $ob->reply (undef, "usekeys" . ($oldtype == $ob->contr->usekeys ? "" : " now") . " set to " . $types[$ob->contr->usekeys]);
187
188 1
189};
190
191cf::register_command afk => sub {
192 my ($ob, $arg) = @_;
193
194 $ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
195 $ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
196
197 1
198};
199
200cf::register_command sound => sub {
201 my ($ob, $arg) = @_;
202
203 $ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
204 $ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
205
206 1
207};
208
209cf::register_command brace => sub {
210 my ($ob, $arg) = @_;
211
212 $ob->contr->braced ($ob->contr->braced ? 0 : 1);
213 $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
214
215 1
216};
217
218cf::register_command 'output-count' => sub {
219 my ($ob, $arg) = @_;
220
221 return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
222 unless $arg > 0;
223
224 $ob->contr->outputs_count ($arg);
225 $ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
226
227 1
228};
229
230cf::register_command 'output-sync' => sub {
231 my ($ob, $arg) = @_;
232
233 return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync)
234 unless $arg > 0;
235
236 $ob->contr->outputs_sync ($arg);
237 $ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync);
238
239 1
240};
241
242# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
243# some other level (which may also be 0), this does not get echoed,
244# but it does get set.
245cf::register_command wimpy => sub {
246 my ($ob, $arg) = @_;
247
248 my $wimpy = $ob->run_away;
249 return $ob->reply (undef, "Your current wimpy level is $wimpy.")
250 if $arg eq "";
251
252 return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
253 if $arg =~ /^\d+$/ and $arg <= 100;
254
255 $ob->reply (undef, "Incorrect parameters for wimpy: $arg");
256
257 1
258};
259
260cf::register_command peaceful => sub {
261 my ($ob, $arg) = @_;
262
263 $ob->reply (undef, "You cannot change your peaceful setting with this command."
264 ." Please speak to the priest in the temple of Gorokh"
265 ." if you want to become hostile or in temple of Valriel"
266 ." if you want to become peaceful again.");
267
268 #$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
269 #$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
88 270
89 1 271 1
90}; 272};
91 273
92cf::register_command rename => sub { 274cf::register_command rename => sub {
… …
134cf::register_command maps => sub { 316cf::register_command maps => sub {
135 my ($ob, $arg) = @_; 317 my ($ob, $arg) = @_;
136 318
137 no re 'eval'; $arg = qr<$arg>; 319 no re 'eval'; $arg = qr<$arg>;
138 320
139 my $format = "%2s %1s %3s %5s %-60.60s\n"; 321 my $format = "%2s %1s %3s %5s %.60s\n";
140 322
141 $ob->reply (undef, sprintf $format, "Pl", "I", "Svd", "Reset", "Name"); 323 $ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK | cf::NDI_UNIQUE);
142 324
143 for (sort keys %cf::MAP) { 325 for (sort keys %cf::MAP) {
144 my $map = $cf::MAP{$_} 326 my $map = $cf::MAP{$_}
145 or next; 327 or next;
146 328
147 next unless $map->path =~ $arg; 329 next unless $map->path =~ $arg;
330 next if $map->{deny_list};
148 331
149 my $svd = int $cf::RUNTIME - $map->{last_save}; 332 my $svd = int $cf::RUNTIME - $map->{last_save};
150 $svd = "++" if $svd > 99; 333 $svd = "++" if $svd > 99;
151 334
152 $ob->reply (undef, sprintf $format, 335 $ob->reply (undef,
336 (sprintf $format,
153 (scalar $map->players), 337 (scalar $map->players),
154 $IN_MEMORY{$map->in_memory} || "?", 338 $IN_MEMORY{$map->in_memory} || "?",
155 $svd, 339 $svd,
156 (int $map->reset_at - $cf::RUNTIME), 340 (int $map->reset_at - $cf::RUNTIME),
157 $map->{path}->visible_name); 341 $map->visible_name),
342 cf::NDI_BLACK | cf::NDI_UNIQUE);
158 } 343 }
159 344
160 1 345 1
161}; 346};
162 347

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines