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

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.24 by pippijn, Fri Mar 2 11:07:59 2007 UTC vs.
Revision 1.76 by root, Mon Apr 12 05:22:37 2010 UTC

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

Comparing deliantra/server/ext/commands.ext (file contents): Revision 1.24 by pippijn, Fri Mar 2 11:07:59 2007 UTC vs. Revision 1.76 by root, Mon Apr 12 05:22:37 2010 UTC

Diff Legend

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.24 by pippijn, Fri Mar 2 11:07:59 2007 UTC vs.
Revision 1.76 by root, Mon Apr 12 05:22:37 2010 UTC