[ViewVC] Diff of: cvs/deliantra/server/ext/commands.ext

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.52 by root, Wed Jul 4 17:48:56 2007 UTC vs.
Revision 1.75 by root, Thu Apr 8 17:36:53 2010 UTC

…		…
1	#! perl # mandatory depends=irc	1	#! perl # mandatory depends=irc
2		2
3	use POSIX ();	3	use POSIX ();
4		4
5	# miscellaneous commands	5	# miscellaneous commands
6
7	sub 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
41	sub who_listing(;$$) {	7	sub 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	)
…		…
81	cf::register_command who => sub {	47	cf::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
91	cf::register_command seen => sub {	55	cf::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
114	cf::register_command body => sub {	80	cf::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
142	cf::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
164	for 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
187	cf::register_command mapinfo => sub {	142	cf::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;
		149
192	$ob->reply (undef, (sprintf "%s (%s) %s", $map->name, $map->path, $ob->region->longname));	150	my $msg = sprintf "%s (%s)\r%s", $map->name, $map->path, $observe->region->longname;
193	$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",
194	$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
195	if $ob->flag (cf::FLAG_WIZ);	153	if $ob->flag (cf::FLAG_WIZ);
196	$ob->reply (undef, $map->msg);
197		154
198	1	155	$ob->send_msg ("c/mapinfo" => $msg, cf::NDI_REPLY \| cf::NDI_CLEAR);
199	};	156	};
200		157
201	cf::register_command whereami => sub {	158	cf::register_command whereami => sub {
202	my ($ob) = @_;	159	my ($ob) = @_;
203		160
204	my $reg = $ob->contr->observe->region;	161	my $reg = $ob->contr->observe->region;
205	$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	};
206		164
		165	cf::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};
207	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
		180	cf::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);
208	};	185	};
209		186
210	sub _set_mode($$$@) {	187	sub _set_mode($$$@) {
211	my ($name, $ob, $arg, $slot, @choices) = @_;	188	my ($name, $ob, $arg, $slot, @choices) = @_;
212		189
…		…
224		201
225	cf::register_command applymode => sub {	202	cf::register_command applymode => sub {
226	my ($ob, $arg) = @_;	203	my ($ob, $arg) = @_;
227		204
228	_set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);	205	_set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
229
230	1
231	};	206	};
232		207
233	cf::register_command petmode => sub {	208	cf::register_command petmode => sub {
234	my ($ob, $arg) = @_;	209	my ($ob, $arg) = @_;
235		210
236	_set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);	211	_set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
237
238	1
239	};	212	};
240		213
241	cf::register_command usekeys => sub {	214	cf::register_command usekeys => sub {
242	my ($ob, $arg) = @_;	215	my ($ob, $arg) = @_;
243		216
244	_set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);	217	_set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
245
246	1
247	};	218	};
248		219
249	cf::register_command hintmode => sub {	220	cf::register_command hintmode => sub {
250	my ($ob, $arg) = @_;	221	my ($ob, $arg) = @_;
251		222
252	_set_mode "hintmode", $ob, $arg, hintmode => qw(show mark hide);	223	_set_mode "hintmode", $ob, $arg, hintmode => qw(show mark hide);
253
254	1
255	};	224	};
256		225
257	cf::register_command afk => sub {	226	cf::register_command afk => sub {
258	my ($ob, $arg) = @_;	227	my ($ob, $arg) = @_;
259		228
260	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);	229	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
261	$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");
262
263	1
264	};	231	};
265		232
266	cf::register_command sound => sub {	233	cf::register_command sound => sub {
267	my ($ob, $arg) = @_;	234	my ($ob, $arg) = @_;
268		235
269	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);	236	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
270	$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...");
271
272	1
273	};	238	};
274		239
275	cf::register_command brace => sub {	240	cf::register_command brace => sub {
276	my ($ob, $arg) = @_;	241	my ($ob, $arg) = @_;
277		242
278	$ob->contr->braced ($ob->contr->braced ? 0 : 1);	243	$ob->contr->braced ($ob->contr->braced ? 0 : 1);
279	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");	244	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
280
281	1
282	};	245	};
283		246
284	cf::register_command 'output-rate' => sub {	247	cf::register_command 'output-rate' => sub {
285	my ($ob, $arg) = @_;	248	my ($ob, $arg) = @_;
286		249
287	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)
288	unless $arg > 0;	251	unless $arg > 0;
289		252
290	# minimum is 2k/s	253	# minimum is 5k/s
		254	# maximum is 100k/s, this should be configurable
291	$ob->contr->ns->max_rate ((List::Util::max 2048, $arg) * $cf::TICK);	255	$ob->contr->ns->max_rate ((List::Util::max 5000, List::Util::min 100000, $arg) * $cf::TICK);
292	$ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK);	256	$ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK);
293
294	1
295	};	257	};
296		258
297	cf::register_command 'output-count' => sub {	259	cf::register_command 'output-count' => sub {
298	my ($ob, $arg) = @_;	260	my ($ob, $arg) = @_;
299		261
…		…
302		264
303	$arg = 4 if $arg < 4;	265	$arg = 4 if $arg < 4;
304		266
305	$ob->contr->outputs_count ($arg);	267	$ob->contr->outputs_count ($arg);
306	$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);	268	$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
307
308	1
309	};	269	};
310		270
311	cf::register_command 'output-sync' => sub {	271	cf::register_command 'output-sync' => sub {
312	my ($ob, $arg) = @_;	272	my ($ob, $arg) = @_;
313		273
…		…
316		276
317	$arg = 0.5 if $arg < 0.5;	277	$arg = 0.5 if $arg < 0.5;
318		278
319	$ob->contr->outputs_sync ($arg / $cf::TICK);	279	$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);	280	$ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK);
321
322	1
323	};	281	};
324		282
325	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to	283	# 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,	284	# some other level (which may also be 0), this does not get echoed,
327	# but it does get set.	285	# but it does get set.
…		…
334		292
335	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")	293	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
336	if $arg =~ /^\d+$/ and $arg <= 100;	294	if $arg =~ /^\d+$/ and $arg <= 100;
337		295
338	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");	296	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");
339
340	1
341	};	297	};
342		298
343	cf::register_command peaceful => sub {	299	cf::register_command peaceful => sub {
344	my ($ob, $arg) = @_;	300	my ($ob, $arg) = @_;
345		301
…		…
348	." if you want to become hostile or in temple of Valriel"	304	." if you want to become hostile or in temple of Valriel"
349	." if you want to become peaceful again.");	305	." if you want to become peaceful again.");
350		306
351	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);	307	#$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.");	308	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
		309	};
353		310
		311	sub rename_to($$$) {
		312	my ($ob, $from, $to) = @_;
		313
		314	$to =~ /^[a-zA-Z0-9.,=#\/%$!^ ]*$/
		315	or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things.");
		316
		317	127 >= length $to
		318	or return $ob->message ("rename: new name must be <= 127 characters.");
		319
		320	my $item;
		321
		322	if (length $from) {
		323	$item = $ob->find_best_object_match ($from)
		324	or return $ob->message ("rename: could not find a matching item to rename.");
		325	} else {
		326	$item = $ob->find_marked_object
		327	or return $ob->message ("rename: no from name and no marked item found to rename.");
		328	}
		329
		330	$item->custom_name (length $to ? $to : undef);
		331
		332	if (length $to) {
		333	$item->custom_name ($to);
		334	$ob->message ("Your " . $item->base_name . " will now be called $to.");
		335	} else {
		336	$item->custom_name (undef);
		337	$ob->message ("You stop calling your " . $item->base_name . " with weird names.");
		338	}
		339
		340	$ob->esrv_update_item (cf::UPD_NAME, $item);
		341
354	1	342	1
355	};	343	}
356		344
357	cf::register_command rename => sub {	345	cf::register_command rename => sub {
358	my ($ob, $arg) = @_;	346	my ($ob, $arg) = @_;
359		347
360	$ob->speed_left ($ob->speed_left - 0.25);	348	$ob->speed_left ($ob->speed_left - 0.25);
…		…
374	# does not unquote $1 or $3	362	# does not unquote $1 or $3
375	rename_to $ob, $2\|\|$1, $4\|\|$3;	363	rename_to $ob, $2\|\|$1, $4\|\|$3;
376	} else {	364	} else {
377	$ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');	365	$ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
378	}	366	}
379
380	1
381	};	367	};
382		368
383	cf::register_command uptime => sub {	369	cf::register_command uptime => sub {
384	my ($ob, $arg) = @_;	370	my ($ob, $arg) = @_;
385		371
386	my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;	372	my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;
387	my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;	373	my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;
388	$ob->reply (undef, "server started $startup, uptime ${runtime}\d");	374	$ob->send_msg ("c/uptime" => "server started $startup, uptime ${runtime}\d", cf::NDI_REPLY \| cf::NDI_CLEAR);
389
390	1
391	};	375	};
392		376
393	my %IN_MEMORY = (	377	my %IN_MEMORY = (
394	cf::MAP_IN_MEMORY => "I",	378	cf::MAP_ACTIVE => "I",
395	cf::MAP_SWAPPED => "S",	379	cf::MAP_SWAPPED => "S",
396	cf::MAP_LOADING => "L",	380	cf::MAP_LOADING => "L",
397	);	381	);
398		382
399	cf::register_command maps => sub {	383	cf::register_command maps => sub {
400	my ($ob, $arg) = @_;	384	my ($ob, $arg) = @_;
401		385
402	no re 'eval'; $arg = qr<$arg>;	386	no re 'eval'; $arg = qr<$arg>;
403		387
404	my $format = "%2s %1s %3s %5s %.60s\n";	388	my $format = " %2s %1s %3s %5s %.60s\n";
405		389
406	$ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK \| cf::NDI_UNIQUE);	390	my $msg = "\n" . sprintf $format, "Pl", "I", "Svd", "Reset", "Name";
407		391
408	for (sort keys %cf::MAP) {	392	for (sort keys %cf::MAP) {
409	my $map = $cf::MAP{$_}	393	my $map = $cf::MAP{$_}
410	or next;	394	or next;
411		395
…		…
413	next if $map->{deny_list};	397	next if $map->{deny_list};
414		398
415	my $svd = int $cf::RUNTIME - $map->{last_save};	399	my $svd = int $cf::RUNTIME - $map->{last_save};
416	$svd = "++" if $svd > 99;	400	$svd = "++" if $svd > 99;
417		401
418	$ob->reply (undef,	402	$msg .= sprintf $format,
419	(sprintf $format,
420	(scalar $map->players),	403	(scalar $map->players),
421	$IN_MEMORY{$map->in_memory} \|\| "?",	404	$IN_MEMORY{$map->in_memory} \|\| "?",
422	$svd,	405	$svd,
423	(int $map->reset_at - $cf::RUNTIME),	406	(int $map->reset_at - $cf::RUNTIME),
424	$map->visible_name),	407	$map->visible_name;
425	cf::NDI_BLACK \| cf::NDI_UNIQUE);
426	}
427
428	1	408	}
429	};
430		409
		410	$ob->send_msg ("c/mapinfo" => $msg, cf::NDI_REPLY \| cf::NDI_CLEAR);
		411	};
		412

Diff Legend

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

Comparing deliantra/server/ext/commands.ext (file contents): Revision 1.52 by root, Wed Jul 4 17:48:56 2007 UTC vs. Revision 1.75 by root, Thu Apr 8 17:36:53 2010 UTC

Diff Legend

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.52 by root, Wed Jul 4 17:48:56 2007 UTC vs.
Revision 1.75 by root, Thu Apr 8 17:36:53 2010 UTC