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.57 by root, Sat Jul 28 00:15:03 2007 UTC vs.
Revision 1.76 by root, Mon Apr 12 05:22:37 2010 UTC

1#! perl # mandatory depends=irc 1#! perl # mandatory depends=irc
2 2
3use POSIX (); 3use POSIX ();
4 4
5# miscellaneous commands 5# miscellaneous commands
6
7sub rename_to($$$) {
8 my ($ob, $from, $to) = @_;
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.");
12
13 127 >= length $to
14 or return $ob->message ("rename: new name must be <= 127 characters.");
15
16 my $item;
17
18 if (length $from) {
19 $item = $ob->find_best_object_match ($from)
20 or return $ob->message ("rename: could not find a matching item to rename.");
21 } else {
22 $item = $ob->find_marked_object
23 or return $ob->message ("rename: no from name and no marked item found to rename.");
24 }
25
26 $item->custom_name (length $to ? $to : undef);
27
28 if (length $to) {
29 $item->custom_name ($to);
30 $ob->message ("Your " . $item->base_name . " will now be called $to.");
31 } else {
32 $item->custom_name (undef);
33 $ob->message ("You stop calling your " . $item->base_name . " with weird names.");
34 }
35
36 $ob->esrv_update_item (cf::UPD_NAME, $item);
37
38 1
39}
40 6
41sub who_listing(;$$) { 7sub who_listing(;$$) {
42 my ($privileged, $select) = @_; 8 my ($privileged, $select) = @_;
43 9
44 my ($numwiz, $numafk) = (0, 0); 10 my ($numwiz, $numafk) = (0, 0);
… …
66 "* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title) 32 "* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
67 . ($pl->gender ? " [f]" : " [m]") 33 . ($pl->gender ? " [f]" : " [m]")
68 . ($pl->peaceful ? " [peaceful]" : " [HOSTILE]") 34 . ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
69 . ($ns->afk ? " [AFK]" : "") 35 . ($ns->afk ? " [AFK]" : "")
70 . ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "") 36 . ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
71 . " [" . $pl->ns->version . "]" 37 . " [" . $pl->ns->{who_version} . "]"
72 . " [" . ($pl->peaceful || $privileged ? $ob->map->visible_name : $ob->region->name) . "]" 38 . " [" . ($pl->peaceful || $privileged ? $ob->map->visible_name : $ob->region->name) . "]"
73 . (sprintf " [rtt %.3fs]", $pl->ns->tcpi_rtt * 1e-6) 39 . (sprintf " [rtt %.3fs]", $pl->ns->tcpi_rtt * 1e-6)
74 . ($privileged ? " " . $pl->ns->host : "") 40 . ($privileged ? " " . $pl->ns->host : "")
75 } sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl 41 } sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
76 ), 42 ),
… …
81cf::register_command who => sub { 47cf::register_command who => sub {
82 my ($ob, $arg) = @_; 48 my ($ob, $arg) = @_;
83 49
84 $ob->speed_left ($ob->speed_left - 4); 50 $ob->speed_left ($ob->speed_left - 4);
85 51
86 $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who"), $arg), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE); 52 $ob->send_msg ("c/who" => (join "\r", who_listing $ob->may ("extended_who"), $arg), cf::NDI_DK_ORANGE | cf::NDI_REPLY | cf::NDI_CLEAR | cf::NDI_DEF);
87
88 1
89}; 53};
90 54
91cf::register_command seen => sub { 55cf::register_command seen => sub {
92 my ($pl, $args) = @_; 56 my ($pl, $args) = @_;
93 57
58 cf::async {
94 if (my ($login) = $args =~ /(\S+)/) { 59 if (my ($login) = $args =~ /(\S+)/) {
95 if ($login eq $pl->name) { 60 if ($login eq $pl->name) {
96 $pl->message ("Very funny, $login. Ha. Ha.", cf::NDI_UNIQUE); 61 $pl->message ("Very funny, $login. Ha. Ha.", cf::NDI_REPLY);
97 } elsif (cf::player::find_active $login) { 62 } elsif (cf::player::find_active $login) {
98 $pl->message ("$login is right here on this server!", cf::NDI_UNIQUE); 63 $pl->message ("$login is right here on this server!", cf::NDI_REPLY);
99 } elsif (cf::player::exists $login 64 } elsif (cf::player::exists $login
100 and stat cf::player::path $login) { 65 and stat cf::player::path $login) {
101 my $time = (stat _)[9]; 66 my $time = (stat _)[9];
102 67
103 $pl->message ("$login was last seen here " 68 $pl->message ("$login was last seen here "
104 . (POSIX::strftime "%Y-%m-%d %H:%M:%S +0000", gmtime $time) 69 . (POSIX::strftime "%Y-%m-%d %H:%M:%S +0000", gmtime $time)
105 . " which was " . (int +(time - $time) / 3600) . " hours ago.", cf::NDI_UNIQUE); 70 . " which was " . (int +(time - $time) / 3600) . " hours ago.", cf::NDI_REPLY);
71 } else {
72 $pl->message ("No player named $login is known to me.", cf::NDI_REPLY);
73 }
106 } else { 74 } else {
107 $pl->message ("No player named $login is known to me.", cf::NDI_UNIQUE); 75 $pl->message ("Usage: seen <player>", cf::NDI_REPLY);
108 } 76 }
109 } else {
110 $pl->message ("Usage: seen <player>", cf::NDI_UNIQUE);
111 } 77 };
112}; 78};
113 79
114cf::register_command body => sub { 80cf::register_command body => sub {
115 my ($ob) = @_; 81 my ($ob) = @_;
82
83 my $observe = $ob->contr->observe;
116 84
117 # Too hard to try and make a header that lines everything up, so just 85 # Too hard to try and make a header that lines everything up, so just
118 # give a description. (comment from C++) 86 # give a description. (comment from C++)
119 my $reply = 87 my $reply =
120 "The first column is the name of the body location.\n\n" 88 "The first column is the name of the body location.\r"
121 . "The second column is how many of those locations your body has.\n\n" 89 . "The second column is how many of those locations your body has.\r"
122 . "The third column is how many slots in that location are available.\n\n"; 90 . "The third column is how many slots in that location are available.\r"
91 . "The last column shows the items currently using the slot\n\n";
123 92
93 # first process all applied items and hash them into their slots
94 my @slot;
95
96 for my $item (grep $_->flag (cf::FLAG_APPLIED), $observe->inv) {
97 $item->slot_info ($_)
98 and push @{ $slot[$_] }, $item
99 for 0 .. cf::NUM_BODY_LOCATIONS-1;
100 }
101
124 $reply .= sprintf " %-20s %3s %5s\n", "Location", "You", "Avail"; 102 $reply .= sprintf " %-20s %3s %5s %s\n", "Location", "You", "Avail", "What";
125 for (0 .. cf::NUM_BODY_LOCATIONS - 1) { 103 for (0 .. cf::NUM_BODY_LOCATIONS - 1) {
126 my $msg = cf::object::slot_nonuse_name $_; 104 my $msg = cf::object::slot_nonuse_name $_;
127 $msg =~ s/^.*? a //; 105 $msg =~ s/^.*? a //;
128 $reply .= sprintf " %-20s %3d %5d\n", $msg, $ob->slot_info ($_), $ob->slot_used ($_) 106 $reply .= sprintf " %-20s %3d %5d %s\n",
107 $msg,
108 $observe->slot_info ($_),
109 $observe->slot_used ($_),
110 join ", ", map $_->query_short_name, @{ $slot[$_] }
129 if $ob->slot_info ($_) or $ob->slot_used ($_); 111 if $observe->slot_info ($_) || $observe->slot_used ($_);
130 } 112 }
131 113
132 $reply .= "You are not allowed to wear armor\n\n" 114 $reply .= "You are not allowed to wear armor\r"
133 unless $ob->flag (cf::FLAG_USE_ARMOUR); 115 unless $observe->flag (cf::FLAG_USE_ARMOUR);
134 $reply .= "You are not allowed to use weapons\n\n" 116 $reply .= "You are not allowed to use weapons\r"
135 unless $ob->flag (cf::FLAG_USE_WEAPON); 117 unless $observe->flag (cf::FLAG_USE_WEAPON);
136 118
137 $ob->reply (undef, $reply); 119 $ob->send_msg ("c/body" => $reply, cf::NDI_REPLY | cf::NDI_CLEAR);
138
139 1
140}; 120};
141 121
142cf::register_command mark => sub { 122#cf::register_command mark => sub {
143 my ($pl, $arg) = @_; 123# my ($pl, $arg) = @_;
144 124#
145 if (length $arg) { 125# if (length $arg) {
146 my $ob = $pl->find_best_object_match ($arg); 126# my $ob = $pl->find_best_object_match ($arg);
147 127#
148 return $pl->reply (undef, "Could not find an object that matches $arg") 128# return $pl->reply (undef, "Could not find an object that matches $arg")
149 unless $ob; 129# unless $ob;
150 130#
151 $pl->contr->mark ($ob); 131# $pl->contr->mark ($ob);
152 $pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title)); 132# $pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title));
153 } else { 133# } else {
154 my $ob = $pl->find_marked_object; 134# my $ob = $pl->find_marked_object;
155 135#
156 $pl->reply (undef, $ob 136# $pl->reply (undef, $ob
157 ? (sprintf "%s %s * is marked.", $ob->name, $ob->title) 137# ? (sprintf "%s %s * is marked.", $ob->name, $ob->title)
158 : "You have no marked object."); 138# : "You have no marked object.");
159 } 139# }
160
161 1
162}; 140#};
163
164for my $cmd ("run", "fire") {
165 my $oncmd = "${cmd}_on";
166 cf::register_command $cmd => sub {
167 my ($ob, $arg) = @_;
168
169 $ob->reply (undef, "Can't $cmd into a non adjacent square.")
170 if $arg < 0 or $arg >= 9;
171
172 $ob->contr->$oncmd (1);
173 $ob->move_player ($arg);
174
175 1
176 };
177
178 cf::register_command "${cmd}_stop" => sub {
179 my ($ob) = @_;
180
181 $ob->contr->$oncmd (0);
182
183 1
184 };
185}
186 141
187cf::register_command mapinfo => sub { 142cf::register_command mapinfo => sub {
188 my ($ob) = @_; 143 my ($ob) = @_;
189 144
190 my $observe = $ob->contr->observe; 145 my $observe = $ob->contr->observe;
191 146
192 my $map = $observe->map 147 my $map = $observe->map
193 or return; 148 or return;
149
194 $ob->reply (undef, (sprintf "%s (%s) %s", $map->name, $map->path, $observe->region->longname)); 150 my $msg = sprintf "%s (%s)\r%s", $map->name, $map->path, $observe->region->longname;
195 $ob->reply (undef, (sprintf "players: %d difficulty: %d size: %d start: %dx%d timeout: %d", 151 $msg .= sprintf "\rplayers: %d difficulty: %d size: %d start: %dx%d timeout: %d",
196 (scalar $map->players), $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout)) 152 (scalar $map->players), $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout
197 if $ob->flag (cf::FLAG_WIZ); 153 if $ob->flag (cf::FLAG_WIZ);
198 $ob->reply (undef, $map->msg);
199 154
200 1 155 $ob->send_msg ("c/mapinfo" => $msg, cf::NDI_REPLY | cf::NDI_CLEAR);
201}; 156};
202 157
203cf::register_command whereami => sub { 158cf::register_command whereami => sub {
204 my ($ob) = @_; 159 my ($ob) = @_;
205 160
206 my $reg = $ob->contr->observe->region; 161 my $reg = $ob->contr->observe->region;
207 $ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg)); 162 $ob->send_msg ("c/who" => (sprintf "You are %s.\n\n%s", $reg->longname, $reg->msg), cf::NDI_REPLY | cf::NDI_CLEAR);
163};
208 164
165cf::register_command whereabouts => sub {
166 my ($ob, $arg) = @_;
167
168 my %count;
169
170 for my $pl (cf::player::list) {
171 ++$count{$pl->ob->region->longname};
209 1 172 }
173
174 my $msg = "T<In the world currently there are:>\n\n"
175 . join "", map { sprintf " C<%3d >player(s) %s\r", $count{$_}, $_ } sort keys %count;
176
177 $ob->send_msg ("c/who" => $msg, cf::NDI_REPLY | cf::NDI_CLEAR);
178};
179
180cf::register_command hiscore => sub {
181 my ($ob, $arg) = @_;
182
183 my $url = $cf::CFG{hiscore_url};
184 $ob->send_msg (log => "See $url", cf::NDI_REPLY);
210}; 185};
211 186
212sub _set_mode($$$@) { 187sub _set_mode($$$@) {
213 my ($name, $ob, $arg, $slot, @choices) = @_; 188 my ($name, $ob, $arg, $slot, @choices) = @_;
214 189
… …
226 201
227cf::register_command applymode => sub { 202cf::register_command applymode => sub {
228 my ($ob, $arg) = @_; 203 my ($ob, $arg) = @_;
229 204
230 _set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always); 205 _set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
231
232 1
233}; 206};
234 207
235cf::register_command petmode => sub { 208cf::register_command petmode => sub {
236 my ($ob, $arg) = @_; 209 my ($ob, $arg) = @_;
237 210
238 _set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena); 211 _set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
239
240 1
241}; 212};
242 213
243cf::register_command usekeys => sub { 214cf::register_command usekeys => sub {
244 my ($ob, $arg) = @_; 215 my ($ob, $arg) = @_;
245 216
246 _set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers); 217 _set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
247
248 1
249}; 218};
250 219
251cf::register_command hintmode => sub { 220cf::register_command hintmode => sub {
252 my ($ob, $arg) = @_; 221 my ($ob, $arg) = @_;
253 222
254 _set_mode "hintmode", $ob, $arg, hintmode => qw(show mark hide); 223 _set_mode "hintmode", $ob, $arg, hintmode => qw(show mark hide);
255
256 1
257}; 224};
258 225
259cf::register_command afk => sub { 226cf::register_command afk => sub {
260 my ($ob, $arg) = @_; 227 my ($ob, $arg) = @_;
261 228
262 $ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1); 229 $ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
263 $ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK"); 230 $ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
264
265 1
266}; 231};
267 232
268cf::register_command sound => sub { 233cf::register_command sound => sub {
269 my ($ob, $arg) = @_; 234 my ($ob, $arg) = @_;
270 235
271 $ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1); 236 $ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
272 $ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden..."); 237 $ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
273
274 1
275}; 238};
276 239
277cf::register_command brace => sub { 240cf::register_command brace => sub {
278 my ($ob, $arg) = @_; 241 my ($ob, $arg) = @_;
279 242
280 $ob->contr->braced ($ob->contr->braced ? 0 : 1); 243 $ob->contr->braced ($ob->contr->braced ? 0 : 1);
281 $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced."); 244 $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
282
283 1
284}; 245};
285 246
286cf::register_command 'output-rate' => sub { 247cf::register_command 'output-rate' => sub {
287 my ($ob, $arg) = @_; 248 my ($ob, $arg) = @_;
288 249
289 return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK) 250 return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK)
290 unless $arg > 0; 251 unless $arg > 0;
291 252
292 # minimum is 5k/s 253 $ob->contr->ns->max_rate ((cf::clamp $arg, $OUTPUT_RATE_MIN, $OUTPUT_RATE_MAX) * $TICK);
293 # maximum is 100k/s, this should be configurable
294 $ob->contr->ns->max_rate ((List::Util::max 5000, List::Util::min 100000, $arg) * $cf::TICK);
295 $ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK); 254 $ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $TICK);
296
297 1
298}; 255};
299 256
300cf::register_command 'output-count' => sub { 257cf::register_command 'output-count' => sub {
301 my ($ob, $arg) = @_; 258 my ($ob, $arg) = @_;
302 259
… …
305 262
306 $arg = 4 if $arg < 4; 263 $arg = 4 if $arg < 4;
307 264
308 $ob->contr->outputs_count ($arg); 265 $ob->contr->outputs_count ($arg);
309 $ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count); 266 $ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
310
311 1
312}; 267};
313 268
314cf::register_command 'output-sync' => sub { 269cf::register_command 'output-sync' => sub {
315 my ($ob, $arg) = @_; 270 my ($ob, $arg) = @_;
316 271
… …
319 274
320 $arg = 0.5 if $arg < 0.5; 275 $arg = 0.5 if $arg < 0.5;
321 276
322 $ob->contr->outputs_sync ($arg / $cf::TICK); 277 $ob->contr->outputs_sync ($arg / $cf::TICK);
323 $ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK); 278 $ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK);
324
325 1
326}; 279};
327 280
328# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to 281# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
329# some other level (which may also be 0), this does not get echoed, 282# some other level (which may also be 0), this does not get echoed,
330# but it does get set. 283# but it does get set.
… …
337 290
338 return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.") 291 return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
339 if $arg =~ /^\d+$/ and $arg <= 100; 292 if $arg =~ /^\d+$/ and $arg <= 100;
340 293
341 $ob->reply (undef, "Incorrect parameters for wimpy: $arg"); 294 $ob->reply (undef, "Incorrect parameters for wimpy: $arg");
342
343 1
344}; 295};
345 296
346cf::register_command peaceful => sub { 297cf::register_command peaceful => sub {
347 my ($ob, $arg) = @_; 298 my ($ob, $arg) = @_;
348 299
… …
351 ." if you want to become hostile or in temple of Valriel" 302 ." if you want to become hostile or in temple of Valriel"
352 ." if you want to become peaceful again."); 303 ." if you want to become peaceful again.");
353 304
354 #$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1); 305 #$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
355 #$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players."); 306 #$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
307};
356 308
309sub rename_to($$$) {
310 my ($ob, $from, $to) = @_;
311
312 $to =~ /^[a-zA-Z0-9.,=#\/%$!^ ]*$/
313 or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things.");
314
315 127 >= length $to
316 or return $ob->message ("rename: new name must be <= 127 characters.");
317
318 my $item;
319
320 if (length $from) {
321 $item = $ob->find_best_object_match ($from)
322 or return $ob->message ("rename: could not find a matching item to rename.");
323 } else {
324 $item = $ob->find_marked_object
325 or return $ob->message ("rename: no from name and no marked item found to rename.");
326 }
327
328 $item->custom_name (length $to ? $to : undef);
329
330 if (length $to) {
331 $item->custom_name ($to);
332 $ob->message ("Your " . $item->base_name . " will now be called $to.");
333 } else {
334 $item->custom_name (undef);
335 $ob->message ("You stop calling your " . $item->base_name . " with weird names.");
336 }
337
338 $ob->esrv_update_item (cf::UPD_NAME, $item);
339
357 1 340 1
358}; 341}
359 342
360cf::register_command rename => sub { 343cf::register_command rename => sub {
361 my ($ob, $arg) = @_; 344 my ($ob, $arg) = @_;
362 345
363 $ob->speed_left ($ob->speed_left - 0.25); 346 $ob->speed_left ($ob->speed_left - 0.25);
… …
377 # does not unquote $1 or $3 360 # does not unquote $1 or $3
378 rename_to $ob, $2||$1, $4||$3; 361 rename_to $ob, $2||$1, $4||$3;
379 } else { 362 } else {
380 $ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"'); 363 $ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
381 } 364 }
382
383 1
384}; 365};
385 366
386cf::register_command uptime => sub { 367cf::register_command uptime => sub {
387 my ($ob, $arg) = @_; 368 my ($ob, $arg) = @_;
388 369
389 my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME; 370 my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;
390 my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400; 371 my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;
391 $ob->reply (undef, "server started $startup, uptime ${runtime}\d"); 372 $ob->send_msg ("c/uptime" => "server started $startup, uptime ${runtime}\d", cf::NDI_REPLY | cf::NDI_CLEAR);
392
393 1
394}; 373};
395 374
396my %IN_MEMORY = ( 375my %IN_MEMORY = (
397 cf::MAP_IN_MEMORY => "I", 376 cf::MAP_ACTIVE => "I",
398 cf::MAP_SWAPPED => "S", 377 cf::MAP_SWAPPED => "S",
399 cf::MAP_LOADING => "L", 378 cf::MAP_LOADING => "L",
400); 379);
401 380
402cf::register_command maps => sub { 381cf::register_command maps => sub {
403 my ($ob, $arg) = @_; 382 my ($ob, $arg) = @_;
404 383
405 no re 'eval'; $arg = qr<$arg>; 384 no re 'eval'; $arg = qr<$arg>;
406 385
407 my $format = "%2s %1s %3s %5s %.60s\n"; 386 my $format = " %2s %1s %3s %5s %.60s\n";
408 387
409 $ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK | cf::NDI_UNIQUE); 388 my $msg = "\n" . sprintf $format, "Pl", "I", "Svd", "Reset", "Name";
410 389
411 for (sort keys %cf::MAP) { 390 for (sort keys %cf::MAP) {
412 my $map = $cf::MAP{$_} 391 my $map = $cf::MAP{$_}
413 or next; 392 or next;
414 393
… …
416 next if $map->{deny_list}; 395 next if $map->{deny_list};
417 396
418 my $svd = int $cf::RUNTIME - $map->{last_save}; 397 my $svd = int $cf::RUNTIME - $map->{last_save};
419 $svd = "++" if $svd > 99; 398 $svd = "++" if $svd > 99;
420 399
421 $ob->reply (undef, 400 $msg .= sprintf $format,
422 (sprintf $format,
423 (scalar $map->players), 401 (scalar $map->players),
424 $IN_MEMORY{$map->in_memory} || "?", 402 $IN_MEMORY{$map->in_memory} || "?",
425 $svd, 403 $svd,
426 (int $map->reset_at - $cf::RUNTIME), 404 (int $map->reset_at - $cf::RUNTIME),
427 $map->visible_name), 405 $map->visible_name;
428 cf::NDI_BLACK | cf::NDI_UNIQUE);
429 }
430
431 1 406 }
432};
433 407
408 $ob->send_msg ("c/mapinfo" => $msg, cf::NDI_REPLY | cf::NDI_CLEAR);
409};
410

Diff Legend

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