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

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.10 by root, Mon Jan 1 17:50:26 2007 UTC vs.
Revision 1.37 by root, Sat Mar 17 22:52:32 2007 UTC

…		…
1	#! perl	1	#! perl # MANDATORY
2		2
3	use POSIX ();	3	use POSIX ();
4		4
5	# miscellaneous commands	5	# miscellaneous commands
6		6
7	sub rename_to($$$) {	7	sub rename_to($$$) {
8	my ($ob, $from, $to) = @_;	8	my ($ob, $from, $to) = @_;
9		9
10	$to =~ /^[a-zA-Z0-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.");	11	or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things.");
12		12
13	127 >= length $to	13	127 >= length $to
14	or return $ob->message ("rename: new name must be <= 127 characters.");	14	or return $ob->message ("rename: new name must be <= 127 characters.");
15		15
17		17
18	if (length $from) {	18	if (length $from) {
19	$item = $ob->find_best_object_match ($from)	19	$item = $ob->find_best_object_match ($from)
20	or return $ob->message ("rename: could not find a matching item to rename.");	20	or return $ob->message ("rename: could not find a matching item to rename.");
21	} else {	21	} else {
22	$item = $ob->find_marked_object ()	22	$item = $ob->find_marked_object
23	or return $ob->message ("rename: no from name and no marked item found to rename.");	23	or return $ob->message ("rename: no from name and no marked item found to rename.");
24	}	24	}
25		25
26	$item->custom_name (length $to ? $to : undef);	26	$item->custom_name (length $to ? $to : undef);
27		27
…		…
68	"* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)	68	"* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
69	. ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")	69	. ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
70	. ($ns->afk ? " [AFK]" : "")	70	. ($ns->afk ? " [AFK]" : "")
71	. ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")	71	. ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
72	. " [" . $pl->ns->version . "]"	72	. " [" . $pl->ns->version . "]"
73	. " [" . ($pl->peaceful \|\| $privileged ? $ob->map->{path}->visible_name : $ob->map->region ? $ob->map->region->name : "the unknown") . "]"	73	. " [" . ($pl->peaceful \|\| $privileged ? $ob->map->visible_name : $ob->region->name) . "]"
74	. (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6)	74	. (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6)
75	. ($privileged ? " " . $pl->ns->host : "")	75	. ($privileged ? " " . $pl->ns->host : "")
76	} sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl	76	} sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
77	),	77	),
78	eval { "* IRC: " . join ", ", ext::schmorp_irc::users },	78	eval { "* IRC: " . join ", ", ext::schmorp_irc::users },
…		…
83	my ($ob, $arg) = @_;	83	my ($ob, $arg) = @_;
84		84
85	$ob->speed_left ($ob->speed_left - 0.25);	85	$ob->speed_left ($ob->speed_left - 0.25);
86		86
87	$ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE \| cf::NDI_DK_ORANGE);	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 body => sub {
		93	my ($ob) = @_;
		94
		95	my @body_locations = ("in your range slot", "on your arm", "on your body", "on your head",
		96	"around your neck", "in your skill slot", "on your finger", "around your shoulders",
		97	"on your feet", "on your hands", "around your wrists", "around your waist");
		98
		99	# Too hard to try and make a header that lines everything up, so just
		100	# give a description. (comment from C++)
		101	$ob->reply (undef, "The first column is the name of the body location.");
		102	$ob->reply (undef, "The second column is how many of those locations your body has.");
		103	$ob->reply (undef, "The third column is how many slots in that location are available.");
		104
		105	for (0 .. scalar @body_locations - 1) {
		106	$ob->reply (undef, (sprintf "%-30s %5d %5d", $body_locations[$_], $ob->body_info($_), $ob->body_used($_)))
		107	if $ob->body_info($_) or $ob->body_used($_);
		108	}
		109
		110	$ob->reply (undef, "You are not allowed to wear armor")
		111	unless $ob->flag (cf::FLAG_USE_ARMOUR);
		112	$ob->reply (undef, "You are not allowed to use weapons")
		113	unless $ob->flag (cf::FLAG_USE_WEAPON);
		114
		115	1
		116	};
		117
		118	cf::register_command mark => sub {
		119	my ($pl, $arg) = @_;
		120
		121	if (length $arg) {
		122	my $ob = $pl->find_best_object_match ($arg);
		123
		124	return $pl->reply (undef, "Could not find an object that matches $arg")
		125	unless $ob;
		126
		127	$pl->contr->mark ($ob);
		128	$pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title));
		129	} else {
		130	my $ob = $pl->find_marked_object;
		131
		132	$pl->reply (undef, $ob
		133	? (sprintf "%s %s * is marked.", $ob->name, $ob->title)
		134	: "You have no marked object.");
		135	}
		136
		137	1
		138	};
		139
		140	for my $cmd ("run", "fire") {
		141	my $oncmd = "${cmd}_on";
		142	cf::register_command $cmd => sub {
		143	my ($ob, $arg) = @_;
		144
		145	$ob->reply (undef, "Can't $cmd into a non adjacent square.")
		146	if $arg < 0 or $arg >= 9;
		147
		148	$ob->contr->$oncmd (1);
		149	$ob->move_player ($arg);
		150
		151	1
		152	};
		153
		154	cf::register_command "${cmd}_stop" => sub {
		155	my ($ob) = @_;
		156
		157	$ob->contr->$oncmd (0);
		158
		159	1
		160	};
		161	}
		162
		163	cf::register_command mapinfo => sub {
		164	my ($ob) = @_;
		165
		166	my $map = $ob->map
		167	or return;
		168	$ob->reply (undef, (sprintf "%s (%s) %s", $map->name, $map->path, $ob->region->longname));
		169	$ob->reply (undef, (sprintf "players: %d difficulty: %d size: %d start: %dx%d timeout: %d",
		170	$map->players, $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout))
		171	if $ob->flag (cf::FLAG_WIZ);
		172	$ob->reply (undef, $map->msg);
		173
		174	1
		175	};
		176
		177	cf::register_command whereami => sub {
		178	my ($ob) = @_;
		179
		180	my $reg = $ob->region;
		181	$ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg));
		182
		183	1
		184	};
		185
		186	sub _set_mode($$$@) {
		187	my ($name, $ob, $arg, $slot, @choices) = @_;
		188
		189	my $oldmode = $ob->contr->$slot;
		190
		191	return $ob->reply (undef, "$name is set to $choices[$oldmode]")
		192	unless $arg;
		193
		194	my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices
		195	or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1;
		196
		197	$ob->contr->$slot ($idx);
		198	$ob->reply (undef, "$name" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $choices[$ob->contr->$slot]);
		199	}
		200
		201	cf::register_command applymode => sub {
		202	my ($ob, $arg) = @_;
		203
		204	_set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
		205
		206	1
		207	};
		208
		209	cf::register_command petmode => sub {
		210	my ($ob, $arg) = @_;
		211
		212	_set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
		213
		214	1
		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	1
		223	};
		224
		225	cf::register_command afk => sub {
		226	my ($ob, $arg) = @_;
		227
		228	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
		229	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
		230
		231	1
		232	};
		233
		234	cf::register_command sound => sub {
		235	my ($ob, $arg) = @_;
		236
		237	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
		238	$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
		239
		240	1
		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	1
		250	};
		251
		252	cf::register_command 'output-rate' => sub {
		253	my ($ob, $arg) = @_;
		254
		255	return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK)
		256	unless $arg > 0;
		257
		258	$ob->contr->ns->max_rate ($arg * $cf::TICK);
		259	$ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK);
		260
		261	1
		262	};
		263
		264	cf::register_command 'output-count' => sub {
		265	my ($ob, $arg) = @_;
		266
		267	return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
		268	unless $arg > 0;
		269
		270	$ob->contr->outputs_count ($arg);
		271	$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
		272
		273	1
		274	};
		275
		276	cf::register_command 'output-sync' => sub {
		277	my ($ob, $arg) = @_;
		278
		279	return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync)
		280	unless $arg > 0;
		281
		282	$ob->contr->outputs_sync ($arg);
		283	$ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync);
		284
		285	1
		286	};
		287
		288	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
		289	# some other level (which may also be 0), this does not get echoed,
		290	# but it does get set.
		291	cf::register_command wimpy => sub {
		292	my ($ob, $arg) = @_;
		293
		294	my $wimpy = $ob->run_away;
		295	return $ob->reply (undef, "Your current wimpy level is $wimpy.")
		296	if $arg eq "";
		297
		298	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
		299	if $arg =~ /^\d+$/ and $arg <= 100;
		300
		301	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");
		302
		303	1
		304	};
		305
		306	cf::register_command peaceful => sub {
		307	my ($ob, $arg) = @_;
		308
		309	$ob->reply (undef, "You cannot change your peaceful setting with this command."
		310	." Please speak to the priest in the temple of Gorokh"
		311	." if you want to become hostile or in temple of Valriel"
		312	." if you want to become peaceful again.");
		313
		314	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
		315	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
88		316
89	1	317	1
90	};	318	};
91		319
92	cf::register_command rename => sub {	320	cf::register_command rename => sub {
…		…
134	cf::register_command maps => sub {	362	cf::register_command maps => sub {
135	my ($ob, $arg) = @_;	363	my ($ob, $arg) = @_;
136		364
137	no re 'eval'; $arg = qr<$arg>;	365	no re 'eval'; $arg = qr<$arg>;
138		366
139	my $format = "%2s %1s %3s %5s %-60.60s\n";	367	my $format = "%2s %1s %3s %5s %.60s\n";
140		368
141	my $msg = sprintf $format, "Pl", "I", "Svd", "Reset", "Name";	369	$ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK \| cf::NDI_UNIQUE);
142		370
143	for (sort keys %cf::MAP) {	371	for (sort keys %cf::MAP) {
144	my $map = $cf::MAP{$_}	372	my $map = $cf::MAP{$_}
145	or next;	373	or next;
146		374
147	next unless $map->path =~ $arg;	375	next unless $map->path =~ $arg;
		376	next if $map->{deny_list};
148		377
149	my $svd = int $cf::RUNTIME - $map->{last_save};	378	my $svd = int $cf::RUNTIME - $map->{last_save};
150	$svd = "++" if $svd > 99;	379	$svd = "++" if $svd > 99;
151		380
152	$msg .= sprintf $format,	381	$ob->reply (undef,
		382	(sprintf $format,
153	(scalar $map->players),	383	(scalar $map->players),
154	$IN_MEMORY{$map->in_memory} \|\| "?",	384	$IN_MEMORY{$map->in_memory} \|\| "?",
155	$svd,	385	$svd,
156	(int $map->reset_at - $cf::RUNTIME),	386	(int $map->reset_at - $cf::RUNTIME),
157	$map->{path}->visible_name;	387	$map->visible_name),
158	}	388	cf::NDI_BLACK \| cf::NDI_UNIQUE);
159
160	$ob->reply (undef, $msg);
161
162	1	389	}
163	};
164		390
		391	1
		392	};
		393

Diff Legend

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

Comparing deliantra/server/ext/commands.ext (file contents): Revision 1.10 by root, Mon Jan 1 17:50:26 2007 UTC vs. Revision 1.37 by root, Sat Mar 17 22:52:32 2007 UTC

Diff Legend

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.10 by root, Mon Jan 1 17:50:26 2007 UTC vs.
Revision 1.37 by root, Sat Mar 17 22:52:32 2007 UTC