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

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.25 by pippijn, Fri Mar 2 11:13:50 2007 UTC vs.
Revision 1.71 by root, Tue Sep 23 00:24:52 2008 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->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	# Too hard to try and make a header that lines everything up, so just
		84	# give a description. (comment from C++)
		85	my $reply =
		86	"The first column is the name of the body location.\r"
		87	. "The second column is how many of those locations your body has.\r"
		88	. "The third column is how many slots in that location are available.\n\n";
		89
		90	$reply .= sprintf " %-20s %3s %5s\n", "Location", "You", "Avail";
		91	for (0 .. cf::NUM_BODY_LOCATIONS - 1) {
		92	my $msg = cf::object::slot_nonuse_name $_;
		93	$msg =~ s/^.*? a //;
		94	$reply .= sprintf " %-20s %3d %5d\n", $msg, $ob->slot_info ($_), $ob->slot_used ($_)
		95	if $ob->slot_info ($_) or $ob->slot_used ($_);
		96	}
		97
		98	$reply .= "You are not allowed to wear armor\r"
		99	unless $ob->flag (cf::FLAG_USE_ARMOUR);
		100	$reply .= "You are not allowed to use weapons\r"
		101	unless $ob->flag (cf::FLAG_USE_WEAPON);
		102
		103	$ob->send_msg ("c/body" => $reply, cf::NDI_REPLY);
		104	};
		105
		106	cf::register_command mark => sub {
		107	my ($pl, $arg) = @_;
		108
		109	if (length $arg) {
		110	my $ob = $pl->find_best_object_match ($arg);
		111
		112	return $pl->reply (undef, "Could not find an object that matches $arg")
		113	unless $ob;
		114
		115	$pl->contr->mark ($ob);
		116	$pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title));
		117	} else {
		118	my $ob = $pl->find_marked_object;
		119
		120	$pl->reply (undef, $ob
		121	? (sprintf "%s %s * is marked.", $ob->name, $ob->title)
		122	: "You have no marked object.");
		123	}
		124	};
		125
		126	for my $cmd ("run", "fire") {
		127	my $oncmd = "${cmd}_on";
		128	cf::register_command $cmd => sub {
		129	my ($ob, $arg) = @_;
		130
		131	$ob->reply (undef, "Can't $cmd into a non adjacent square.")
		132	if $arg < 0 or $arg >= 9;
		133
		134	$ob->contr->$oncmd (1);
		135	$ob->move_player ($arg);
		136	};
		137
		138	cf::register_command "${cmd}_stop" => sub {
		139	my ($ob) = @_;
		140
		141	$ob->contr->$oncmd (0);
		142	};
		143	}
		144
		145	cf::register_command mapinfo => sub {
		146	my ($ob) = @_;
		147
		148	my $observe = $ob->contr->observe;
		149
		150	my $map = $observe->map
		151	or return;
		152
		153	my $msg = sprintf "%s (%s)\r%s", $map->name, $map->path, $observe->region->longname;
		154	$msg .= sprintf "\rplayers: %d difficulty: %d size: %d start: %dx%d timeout: %d",
		155	(scalar $map->players), $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout
		156	if $ob->flag (cf::FLAG_WIZ);
		157
		158	$ob->send_msg ("c/mapinfo" => $msg, cf::NDI_REPLY \| cf::NDI_CLEAR);
		159	};
		160
		161	cf::register_command whereami => sub {
		162	my ($ob) = @_;
		163
		164	my $reg = $ob->contr->observe->region;
		165	$ob->send_msg ("c/who" => (sprintf "You are %s.\n\n%s", $reg->longname, $reg->msg), cf::NDI_REPLY \| cf::NDI_CLEAR);
		166	};
		167
		168	cf::register_command whereabouts => sub {
		169	my ($ob, $arg) = @_;
		170
		171	my %count;
		172
		173	for my $pl (cf::player::list) {
		174	++$count{$pl->ob->region->longname};
		175	}
		176
		177	my $msg = "T<In the world currently there are:>\n\n"
		178	. join "", map { sprintf " C<%3d >player(s) %s\r", $count{$_}, $_ } sort keys %count;
		179
		180	$ob->send_msg ("c/who" => $msg, cf::NDI_REPLY \| cf::NDI_CLEAR);
		181	};
		182
		183	cf::register_command hiscore => sub {
		184	my ($ob, $arg) = @_;
		185
		186	my $url = $cf::CFG{hiscore_url};
		187	$ob->send_msg (log => "See $url", cf::NDI_REPLY);
		188	};
		189
		190	sub _set_mode($$$@) {
		191	my ($name, $ob, $arg, $slot, @choices) = @_;
		192
		193	my $oldmode = $ob->contr->$slot;
		194
		195	return $ob->reply (undef, "$name is set to $choices[$oldmode]")
		196	unless $arg;
		197
		198	my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices
		199	or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1;
		200
		201	$ob->contr->$slot ($idx);
		202	$ob->reply (undef, "$name" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $choices[$ob->contr->$slot]);
		203	}
		204
		205	cf::register_command applymode => sub {
		206	my ($ob, $arg) = @_;
		207
		208	_set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
		209	};
		210
		211	cf::register_command petmode => sub {
		212	my ($ob, $arg) = @_;
		213
		214	_set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
		215	};
		216
		217	cf::register_command usekeys => sub {
		218	my ($ob, $arg) = @_;
		219
		220	_set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
		221	};
		222
		223	cf::register_command hintmode => sub {
		224	my ($ob, $arg) = @_;
		225
		226	_set_mode "hintmode", $ob, $arg, hintmode => qw(show mark hide);
		227	};
		228
		229	cf::register_command afk => sub {
		230	my ($ob, $arg) = @_;
		231
		232	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
		233	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
		234	};
		235
		236	cf::register_command sound => sub {
		237	my ($ob, $arg) = @_;
		238
		239	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
		240	$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
		241	};
		242
		243	cf::register_command brace => sub {
		244	my ($ob, $arg) = @_;
		245
		246	$ob->contr->braced ($ob->contr->braced ? 0 : 1);
		247	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
		248	};
		249
		250	cf::register_command 'output-rate' => sub {
		251	my ($ob, $arg) = @_;
		252
		253	return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK)
		254	unless $arg > 0;
		255
		256	# minimum is 5k/s
		257	# maximum is 100k/s, this should be configurable
		258	$ob->contr->ns->max_rate ((List::Util::max 5000, List::Util::min 100000, $arg) * $cf::TICK);
		259	$ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK);
		260	};
		261
		262	cf::register_command 'output-count' => sub {
		263	my ($ob, $arg) = @_;
		264
		265	return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
		266	unless $arg > 0;
		267
		268	$arg = 4 if $arg < 4;
		269
		270	$ob->contr->outputs_count ($arg);
		271	$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
		272	};
		273
		274	cf::register_command 'output-sync' => sub {
		275	my ($ob, $arg) = @_;
		276
		277	return $ob->reply (undef, sprintf "Output sync time is presently %.1fs", $ob->contr->outputs_sync * $cf::TICK)
		278	unless length $arg;
		279
		280	$arg = 0.5 if $arg < 0.5;
		281
		282	$ob->contr->outputs_sync ($arg / $cf::TICK);
		283	$ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK);
		284	};
		285
		286	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
		287	# some other level (which may also be 0), this does not get echoed,
		288	# but it does get set.
		289	cf::register_command wimpy => sub {
		290	my ($ob, $arg) = @_;
		291
		292	my $wimpy = $ob->run_away;
		293	return $ob->reply (undef, "Your current wimpy level is $wimpy.")
		294	if $arg eq "";
		295
		296	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
		297	if $arg =~ /^\d+$/ and $arg <= 100;
		298
		299	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");
		300	};
		301
		302	cf::register_command peaceful => sub {
		303	my ($ob, $arg) = @_;
		304
		305	$ob->reply (undef, "You cannot change your peaceful setting with this command."
		306	." Please speak to the priest in the temple of Gorokh"
		307	." if you want to become hostile or in temple of Valriel"
		308	." if you want to become peaceful again.");
		309
		310	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
		311	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
		312	};
6		313
7	sub rename_to($$$) {	314	sub rename_to($$$) {
8	my ($ob, $from, $to) = @_;	315	my ($ob, $from, $to) = @_;
9		316
10	$to =~ /^[a-zA-Z0-9.,=#\/%$!^ ]*$/	317	$to =~ /^[a-zA-Z0-9.,=#\/%$!^ ]*$/
17		324
18	if (length $from) {	325	if (length $from) {
19	$item = $ob->find_best_object_match ($from)	326	$item = $ob->find_best_object_match ($from)
20	or return $ob->message ("rename: could not find a matching item to rename.");	327	or return $ob->message ("rename: could not find a matching item to rename.");
21	} else {	328	} else {
22	$item = $ob->find_marked_object ()	329	$item = $ob->find_marked_object
23	or return $ob->message ("rename: no from name and no marked item found to rename.");	330	or return $ob->message ("rename: no from name and no marked item found to rename.");
24	}	331	}
25		332
26	$item->custom_name (length $to ? $to : undef);	333	$item->custom_name (length $to ? $to : undef);
27		334
…		…
35		342
36	$ob->esrv_update_item (cf::UPD_NAME, $item);	343	$ob->esrv_update_item (cf::UPD_NAME, $item);
37		344
38	1	345	1
39	}	346	}
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 whereami => sub {
93	my ($ob) = @_;
94
95	my $reg = $ob->region;
96	$ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg));
97
98	1
99	};
100
101	cf::register_command applymode => sub {
102	my ($ob, $arg) = @_;
103	my @types = ("nochoice", "never", "always");
104	my $mapping = {
105	nochoice => 1,
106	never => 2,
107	always => 3,
108	};
109
110	my $oldmode = $ob->contr->unapply;
111	my $oldmode_name = $types[$oldmode];
112
113	return $ob->reply (undef, "applymode is set to $oldmode_name")
114	unless $arg;
115
116	return $ob->reply (undef, "applymode: Unknown options '$arg', valid options are @types")
117	unless $mapping->{$arg};
118
119	$ob->contr->unapply ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
120	# but $arg would be 0 if a user enters an incorrect value
121	$ob->reply (undef, "applymode" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $types[$ob->contr->unapply]);
122
123	1
124	};
125
126	cf::register_command petmode => sub {
127	my ($ob, $arg) = @_;
128	my @types = ("normal", "sad", "defend", "arena");
129	my $mapping = {
130	normal => 1,
131	sad => 2,
132	defend => 3,
133	arena => 4,
134	};
135
136	my $oldtype = $ob->contr->petmode;
137	my $oldtype_name = $types[$oldtype];
138
139	return $ob->reply (undef, "petmode is set to $oldtype_name")
140	unless $arg;
141
142	return $ob->reply (undef, "petmode: Unknown options '$arg', valid options are @types")
143	unless $mapping->{$arg};
144
145	$ob->contr->petmode ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
146	# but $arg would be 0 if a user enters an incorrect value
147	$ob->reply (undef, "petmode" . ($oldtype == $ob->contr->petmode ? "" : " now") . " set to " . $types[$ob->contr->petmode]);
148
149	1
150	};
151
152	cf::register_command usekeys => sub {
153	my ($ob, $arg) = @_;
154	my @types = ("inventory", "keyrings", "containers");
155	my $mapping = {
156	inventory => 1,
157	keyrings => 2,
158	containers => 3,
159	};
160
161	my $oldtype = $ob->contr->usekeys;
162	my $oldtype_name = $types[$oldtype];
163
164	return $ob->reply (undef, "usekeys is set to $oldtype_name")
165	unless $arg;
166
167	return $ob->reply (undef, "usekeys: Unknown options '$arg', valid options are @types")
168	unless $mapping->{$arg};
169
170	$ob->contr->usekeys ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
171	# but $arg would be 0 if a user enters an incorrect value
172	$ob->reply (undef, "usekeys" . ($oldtype == $ob->contr->usekeys ? "" : " now") . " set to " . $types[$ob->contr->usekeys]);
173
174	1
175	};
176
177	cf::register_command afk => sub {
178	my ($ob, $arg) = @_;
179
180	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
181	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
182
183	1
184	};
185
186	cf::register_command sound => sub {
187	my ($ob, $arg) = @_;
188
189	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
190	$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
191
192	1
193	};
194
195	cf::register_command brace => sub {
196	my ($ob, $arg) = @_;
197
198	$ob->contr->braced ($ob->contr->braced ? 0 : 1);
199	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
200
201	1
202	};
203
204	cf::register_command 'output-count' => sub {
205	my ($ob, $arg) = @_;
206
207	return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
208	unless $arg > 0;
209
210	$ob->contr->outputs_count ($arg);
211	$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
212
213	1
214	};
215
216	cf::register_command 'output-sync' => sub {
217	my ($ob, $arg) = @_;
218
219	return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync)
220	unless $arg > 0;
221
222	$ob->contr->outputs_sync ($arg);
223	$ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync);
224
225	1
226	};
227
228	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
229	# some other level (which may also be 0), this does not get echoed,
230	# but it does get set.
231	cf::register_command wimpy => sub {
232	my ($ob, $arg) = @_;
233
234	my $wimpy = $ob->run_away;
235	return $ob->reply (undef, "Your current wimpy level is $wimpy.")
236	if $arg eq "";
237
238	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
239	if $arg =~ /^\d+$/ and $arg <= 100;
240
241	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");
242
243	1
244	};
245
246	cf::register_command peaceful => sub {
247	my ($ob, $arg) = @_;
248
249	$ob->reply (undef, "You cannot change your peaceful setting with this command."
250	." Please speak to the priest in the temple of Gorokh"
251	." if you want to become hostile or in temple of Valriel"
252	." if you want to become peaceful again.");
253
254	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
255	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
256
257	1
258	};
259		347
260	cf::register_command rename => sub {	348	cf::register_command rename => sub {
261	my ($ob, $arg) = @_;	349	my ($ob, $arg) = @_;
262		350
263	$ob->speed_left ($ob->speed_left - 0.25);	351	$ob->speed_left ($ob->speed_left - 0.25);
…		…
277	# does not unquote $1 or $3	365	# does not unquote $1 or $3
278	rename_to $ob, $2\|\|$1, $4\|\|$3;	366	rename_to $ob, $2\|\|$1, $4\|\|$3;
279	} else {	367	} else {
280	$ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');	368	$ob->reply (undef, 'Syntax error. Rename usage: rename ["oldname"] to "newname"');
281	}	369	}
282
283	1
284	};	370	};
285		371
286	cf::register_command uptime => sub {	372	cf::register_command uptime => sub {
287	my ($ob, $arg) = @_;	373	my ($ob, $arg) = @_;
288		374
289	my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;	375	my $startup = POSIX::strftime "%Y-%m-%d %H:%M:%S %Z", localtime $cf::UPTIME;
290	my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;	376	my $runtime = sprintf "%.1f", (time - $cf::UPTIME) / 86400;
291	$ob->reply (undef, "server started $startup, uptime ${runtime}\d");	377	$ob->send_msg ("c/uptime" => "server started $startup, uptime ${runtime}\d", cf::NDI_REPLY \| cf::NDI_CLEAR);
292
293	1
294	};	378	};
295		379
296	my %IN_MEMORY = (	380	my %IN_MEMORY = (
297	cf::MAP_IN_MEMORY => "I",	381	cf::MAP_ACTIVE => "I",
298	cf::MAP_SWAPPED => "S",	382	cf::MAP_SWAPPED => "S",
299	cf::MAP_LOADING => "L",	383	cf::MAP_LOADING => "L",
300	);	384	);
301		385
302	cf::register_command maps => sub {	386	cf::register_command maps => sub {
303	my ($ob, $arg) = @_;	387	my ($ob, $arg) = @_;
304		388
305	no re 'eval'; $arg = qr<$arg>;	389	no re 'eval'; $arg = qr<$arg>;
306		390
307	my $format = "%2s %1s %3s %5s %.60s\n";	391	my $format = " %2s %1s %3s %5s %.60s\n";
308		392
309	$ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK \| cf::NDI_UNIQUE);	393	my $msg = "\n" . sprintf $format, "Pl", "I", "Svd", "Reset", "Name";
310		394
311	for (sort keys %cf::MAP) {	395	for (sort keys %cf::MAP) {
312	my $map = $cf::MAP{$_}	396	my $map = $cf::MAP{$_}
313	or next;	397	or next;
314		398
…		…
316	next if $map->{deny_list};	400	next if $map->{deny_list};
317		401
318	my $svd = int $cf::RUNTIME - $map->{last_save};	402	my $svd = int $cf::RUNTIME - $map->{last_save};
319	$svd = "++" if $svd > 99;	403	$svd = "++" if $svd > 99;
320		404
321	$ob->reply (undef,	405	$msg .= sprintf $format,
322	(sprintf $format,
323	(scalar $map->players),	406	(scalar $map->players),
324	$IN_MEMORY{$map->in_memory} \|\| "?",	407	$IN_MEMORY{$map->in_memory} \|\| "?",
325	$svd,	408	$svd,
326	(int $map->reset_at - $cf::RUNTIME),	409	(int $map->reset_at - $cf::RUNTIME),
327	$map->visible_name),	410	$map->visible_name;
328	cf::NDI_BLACK \| cf::NDI_UNIQUE);
329	}
330
331	1	411	}
332	};
333		412
		413	$ob->send_msg ("c/mapinfo" => $msg, cf::NDI_REPLY \| cf::NDI_CLEAR);
		414	};
		415

Diff Legend

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

Comparing deliantra/server/ext/commands.ext (file contents): Revision 1.25 by pippijn, Fri Mar 2 11:13:50 2007 UTC vs. Revision 1.71 by root, Tue Sep 23 00:24:52 2008 UTC

Diff Legend

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.25 by pippijn, Fri Mar 2 11:13:50 2007 UTC vs.
Revision 1.71 by root, Tue Sep 23 00:24:52 2008 UTC