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.51 by root, Tue Jul 3 00:54:44 2007 UTC vs.
Revision 1.84 by root, Sun Jan 29 02:47:04 2017 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->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 ),
77 eval { "* IRC: " . join ", ", ext::irc::users }, 43 eval { "* IRC: " . join ", ", ext::irc::users },
78 ) 44 )
… …
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 !Coro::AIO::aio_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" 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" 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"; 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" 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" 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->mark;
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
145 my $observe = $ob->contr->observe;
146
190 my $map = $ob->contr->observe->map 147 my $map = $observe->map
191 or return; 148 or return;
192 $ob->reply (undef, (sprintf "%s (%s) %s", $map->name, $map->path, $ob->region->longname)); 149
193 $ob->reply (undef, (sprintf "players: %d difficulty: %d size: %d start: %dx%d timeout: %d", 150 my $msg = '';
194 $map->players, $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout)) 151
152 if ($map->name ne '') {
153 $msg .= sprintf "%s [%s] ", $map->name, $map->visible_name
154 } else {
155 $msg .= sprintf "%s ", $map->visible_name
156 }
157
158 if ($map->visible_name ne $map->path) {
159 $msg .= sprintf "(%s) ", $map->path;
160 }
161
162 $msg .= sprintf "\r%s", $observe->region->longname;
163
164 $msg .= sprintf "\rplayers: %d difficulty: %d"
165 . "\rsize: %dx%d start: %dx%d position: (%d|%d) timeout: %d",
166 (scalar $map->players),
167 $map->difficulty,
168 $map->width, $map->height,
169 $map->enter_x, $map->enter_y,
170 $ob->x, $ob->y,
171 $map->timeout
195 if $ob->flag (cf::FLAG_WIZ); 172 if $ob->flag (cf::FLAG_WIZ);
196 $ob->reply (undef, $map->msg);
197 173
198 1 174 $ob->send_msg ("c/mapinfo" => $msg, cf::NDI_REPLY | cf::NDI_CLEAR);
199}; 175};
200 176
201cf::register_command whereami => sub { 177cf::register_command whereami => sub {
202 my ($ob) = @_; 178 my ($ob) = @_;
203 179
204 my $reg = $ob->contr->observe->region; 180 my $reg = $ob->contr->observe->region;
205 $ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg)); 181 $ob->send_msg ("c/who" => (sprintf "You are %s.\n\n%s", $reg->longname, $reg->msg), cf::NDI_REPLY | cf::NDI_CLEAR);
182};
206 183
184cf::register_command whereabouts => sub {
185 my ($ob, $arg) = @_;
186
187 my %count;
188
189 for my $pl (cf::player::list) {
190 ++$count{$pl->ob->region->longname};
207 1 191 }
192
193 my $msg = "T<In the world currently there are:>\n\n"
194 . join "", map { sprintf " C<%3d >player(s) %s\r", $count{$_}, $_ } sort keys %count;
195
196 $ob->send_msg ("c/who" => $msg, cf::NDI_REPLY | cf::NDI_CLEAR);
197};
198
199cf::register_command hiscore => sub {
200 my ($ob, $arg) = @_;
201
202 my $url = $cf::CFG{hiscore_url};
203 $ob->send_msg (log => "See $url", cf::NDI_REPLY);
208}; 204};
209 205
210sub _set_mode($$$@) { 206sub _set_mode($$$@) {
211 my ($name, $ob, $arg, $slot, @choices) = @_; 207 my ($name, $ob, $arg, $slot, @choices) = @_;
212 208
… …
224 220
225cf::register_command applymode => sub { 221cf::register_command applymode => sub {
226 my ($ob, $arg) = @_; 222 my ($ob, $arg) = @_;
227 223
228 _set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always); 224 _set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
229
230 1
231}; 225};
232 226
233cf::register_command petmode => sub { 227cf::register_command petmode => sub {
234 my ($ob, $arg) = @_; 228 my ($ob, $arg) = @_;
235 229
236 _set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena); 230 _set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
237
238 1
239}; 231};
240 232
241cf::register_command usekeys => sub { 233cf::register_command usekeys => sub {
242 my ($ob, $arg) = @_; 234 my ($ob, $arg) = @_;
243 235
244 _set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers); 236 _set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
245
246 1
247}; 237};
248 238
249cf::register_command hintmode => sub { 239cf::register_command hintmode => sub {
250 my ($ob, $arg) = @_; 240 my ($ob, $arg) = @_;
251 241
252 _set_mode "hintmode", $ob, $arg, hintmode => qw(show mark hide); 242 _set_mode "hintmode", $ob, $arg, hintmode => qw(show mark hide);
253
254 1
255}; 243};
256 244
257cf::register_command afk => sub { 245cf::register_command afk => sub {
258 my ($ob, $arg) = @_; 246 my ($ob, $arg) = @_;
259 247
260 $ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1); 248 $ob->contr->ns->afk (!(length $arg ? !$arg : $ob->contr->ns->afk));
261 $ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK"); 249 $ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK." : "You are no longer AFK.");
250};
262 251
263 1 252cf::register_command bumpmsg => sub {
253 my ($ob, $arg) = @_;
254
255 $ob->contr->ns->bumpmsg (!(length $arg ? !$arg : $ob->contr->ns->bumpmsg));
256 $ob->reply (undef, $ob->contr->ns->bumpmsg ? "Bumping into walls sounds more painful now." : "Bumping into walls will now be silent.");
257};
258
259cf::register_command brace => sub {
260 my ($ob, $arg) = @_;
261
262 $ob->contr->braced (!(length $arg ? !$arg : $ob->contr->braced));
263 $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
264}; 264};
265 265
266cf::register_command sound => sub { 266cf::register_command sound => sub {
267 my ($ob, $arg) = @_; 267 my ($ob, $arg) = @_;
268 268
269 $ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1); 269 $ob->contr->ns->sound (!(length $arg ? !$arg : $ob->contr->ns->sound));
270 $ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden..."); 270 $ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
271
272 1
273};
274
275cf::register_command brace => sub {
276 my ($ob, $arg) = @_;
277
278 $ob->contr->braced ($ob->contr->braced ? 0 : 1);
279 $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
280
281 1
282}; 271};
283 272
284cf::register_command 'output-rate' => sub { 273cf::register_command 'output-rate' => sub {
285 my ($ob, $arg) = @_; 274 my ($ob, $arg) = @_;
286 275
287 return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK) 276 return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK)
288 unless $arg > 0; 277 unless $arg > 0;
289 278
290 # minimum is 2k/s 279 $ob->contr->ns->max_rate ((cf::clamp $arg, $OUTPUT_RATE_MIN, $OUTPUT_RATE_MAX) * $TICK);
291 $ob->contr->ns->max_rate ((List::Util::max 2048, $arg) * $cf::TICK);
292 $ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK); 280 $ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $TICK);
293
294 1
295}; 281};
296 282
297cf::register_command 'output-count' => sub { 283cf::register_command 'output-count' => sub {
298 my ($ob, $arg) = @_; 284 my ($ob, $arg) = @_;
299 285
… …
302 288
303 $arg = 4 if $arg < 4; 289 $arg = 4 if $arg < 4;
304 290
305 $ob->contr->outputs_count ($arg); 291 $ob->contr->outputs_count ($arg);
306 $ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count); 292 $ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
307
308 1
309}; 293};
310 294
311cf::register_command 'output-sync' => sub { 295cf::register_command 'output-sync' => sub {
312 my ($ob, $arg) = @_; 296 my ($ob, $arg) = @_;
313 297
… …
316 300
317 $arg = 0.5 if $arg < 0.5; 301 $arg = 0.5 if $arg < 0.5;
318 302
319 $ob->contr->outputs_sync ($arg / $cf::TICK); 303 $ob->contr->outputs_sync ($arg / $cf::TICK);
320 $ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK); 304 $ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK);
321
322 1
323}; 305};
324 306
325# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to 307# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
326# some other level (which may also be 0), this does not get echoed, 308# some other level (which may also be 0), this does not get echoed,
327# but it does get set. 309# but it does get set.
… …
334 316
335 return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.") 317 return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
336 if $arg =~ /^\d+$/ and $arg <= 100; 318 if $arg =~ /^\d+$/ and $arg <= 100;
337 319
338 $ob->reply (undef, "Incorrect parameters for wimpy: $arg"); 320 $ob->reply (undef, "Incorrect parameters for wimpy: $arg");
339
340 1
341}; 321};
342 322
343cf::register_command peaceful => sub { 323cf::register_command peaceful => sub {
344 my ($ob, $arg) = @_; 324 my ($ob, $arg) = @_;
345 325
… …
348 ." if you want to become hostile or in temple of Valriel" 328 ." if you want to become hostile or in temple of Valriel"
349 ." if you want to become peaceful again."); 329 ." if you want to become peaceful again.");
350 330
351 #$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1); 331 #$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
352 #$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players."); 332 #$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
333};
353 334
335sub rename_to($$$) {
336 my ($ob, $from, $to) = @_;
337
338 $to =~ /^[a-zA-Z0-9.,=#\/%$!^ ]*$/
339 or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things.");
340
341 127 >= length $to
342 or return $ob->message ("rename: new name must be <= 127 characters.");
343
344 my $item;
345
346 if (length $from) {
347 $item = $ob->find_best_object_match ($from)
348 or return $ob->message ("rename: could not find a matching item to rename.");
349 } else {
350 $item = $ob->mark
351 or return $ob->message ("rename: no from name and no marked item found to rename.");
352 }
353
354 $item->custom_name (length $to ? $to : undef);
355
356 if (length $to) {
357 $item->custom_name ($to);
358 $ob->message ("Your " . $item->base_name . " will now be called $to.");
359 } else {
360 $item->custom_name (undef);
361 $ob->message ("You stop calling your " . $item->base_name . " with weird names.");
362 }
363
364 $ob->esrv_update_item (cf::UPD_NAME, $item);
365
354 1 366 1
355}; 367}
356 368
357cf::register_command rename => sub { 369cf::register_command rename => sub {
358 my ($ob, $arg) = @_; 370 my ($ob, $arg) = @_;
359 371
360 $ob->speed_left ($ob->speed_left - 0.25); 372 $ob->speed_left ($ob->speed_left - 0.25);
… …
374 # does not unquote $1 or $3 386 # does not unquote $1 or $3
375 rename_to $ob, $2||$1, $4||$3; 387 rename_to $ob, $2||$1, $4||$3;
376 } else { 388 } else {
377 $ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"'); 389 $ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
378 } 390 }
379
380 1
381}; 391};
382 392
383cf::register_command uptime => sub { 393cf::register_command uptime => sub {
384 my ($ob, $arg) = @_; 394 my ($ob, $arg) = @_;
385 395
386 my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME; 396 my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;
387 my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400; 397 my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;
388 $ob->reply (undef, "server started $startup, uptime ${runtime}\d"); 398 $ob->send_msg ("c/uptime" => "server started $startup, uptime ${runtime}\d", cf::NDI_REPLY | cf::NDI_CLEAR);
389
390 1
391}; 399};
392 400
393my %IN_MEMORY = ( 401my %MAP_STATE = (
402 cf::MAP_ACTIVE => "A",
394 cf::MAP_IN_MEMORY => "I", 403 cf::MAP_INACTIVE => "I",
395 cf::MAP_SWAPPED => "S", 404 cf::MAP_SWAPPED => "S",
396 cf::MAP_LOADING => "L",
397); 405);
398 406
399cf::register_command maps => sub { 407cf::register_command maps => sub {
400 my ($ob, $arg) = @_; 408 my ($ob, $arg) = @_;
401 409
402 no re 'eval'; $arg = qr<$arg>; 410 no re 'eval'; $arg = qr<$arg>;
403 411
404 my $format = "%2s %1s %3s %5s %.60s\n"; 412 my $format = " %2s %1s %3s %5s %.60s\n";
405 413
406 $ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK | cf::NDI_UNIQUE); 414 my $msg = "\n" . sprintf $format, "Pl", "S", "Svd", "Reset", "Name";
407 415
408 for (sort keys %cf::MAP) { 416 for (sort keys %cf::MAP) {
409 my $map = $cf::MAP{$_} 417 my $map = $cf::MAP{$_}
410 or next; 418 or next;
411 419
… …
413 next if $map->{deny_list}; 421 next if $map->{deny_list};
414 422
415 my $svd = int $cf::RUNTIME - $map->{last_save}; 423 my $svd = int $cf::RUNTIME - $map->{last_save};
416 $svd = "++" if $svd > 99; 424 $svd = "++" if $svd > 99;
417 425
418 $ob->reply (undef, 426 $msg .= sprintf $format,
419 (sprintf $format,
420 (scalar $map->players), 427 (scalar $map->players),
421 $IN_MEMORY{$map->in_memory} || "?", 428 $MAP_STATE{$map->state} || "?",
422 $svd, 429 $svd,
423 (int $map->reset_at - $cf::RUNTIME), 430 (int $map->reset_at - $cf::RUNTIME),
424 $map->visible_name), 431 $map->visible_name;
425 cf::NDI_BLACK | cf::NDI_UNIQUE);
426 }
427
428 1 432 }
429};
430 433
434 $ob->send_msg ("c/mapinfo" => $msg, cf::NDI_REPLY | cf::NDI_CLEAR);
435};
436

Diff Legend

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