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

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.4 by root, Thu Dec 21 23:37:05 2006 UTC vs.
Revision 1.29 by pippijn, Fri Mar 2 12:16:55 2007 UTC

…		…
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
…		…
45		45
46	my ($numwiz, $numafk) = (0, 0);	46	my ($numwiz, $numafk) = (0, 0);
47	my @pl;	47	my @pl;
48		48
49	foreach my $pl (cf::player::list) {	49	foreach my $pl (cf::player::list) {
		50	my $ns = $pl->ns or next;
50	my $ob = $pl->ob;	51	my $ob = $pl->ob;
51		52
52	next unless $ob->map	53	next unless $ob->map
53	&& ($privileged \|\| !$pl->hidden);	54	&& ($privileged \|\| !$pl->hidden);
54		55
55	$numwiz++ if $ob->flag (cf::FLAG_WIZ);	56	$numwiz++ if $ob->flag (cf::FLAG_WIZ);
56	$numafk++ if $ob->flag (cf::FLAG_AFK);	57	$numafk++ if $ns->afk;
57		58
58	push @pl, $pl;	59	push @pl, $pl;
59	}	60	}
60		61
61	(	62	(
62	"Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)",	63	"Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)",
63	(	64	(
64	map {	65	map {
65	my ($pl, $ob) = ($_, $_->ob);	66	my ($pl, $ob, $ns) = ($_, $_->ob, $_->ns);
66		67
67	"* " . $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)
68	. ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")	69	. ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
69	. ($ob->flag (cf::FLAG_AFK) ? " [AFK]" : "")	70	. ($ns->afk ? " [AFK]" : "")
70	. ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")	71	. ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
71	. " [" . $pl->ns->version . "]"	72	. " [" . $pl->ns->version . "]"
72	. " [" . ($pl->peaceful \|\| $privileged ? $ob->map->path : $ob->map->region ? $ob->map->region->name : "the unknown") . "]"	73	. " [" . ($pl->peaceful \|\| $privileged ? $ob->map->visible_name : $ob->region->name) . "]"
73	. (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6)	74	. (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6)
74	. ($privileged ? " " . $pl->ns->host : "")	75	. ($privileged ? " " . $pl->ns->host : "")
75	} sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl	76	} sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
76	),	77	),
77	eval { "* IRC: " . join ", ", ext::schmorp_irc::users },	78	eval { "* IRC: " . join ", ", ext::schmorp_irc::users },
…		…
82	my ($ob, $arg) = @_;	83	my ($ob, $arg) = @_;
83		84
84	$ob->speed_left ($ob->speed_left - 0.25);	85	$ob->speed_left ($ob->speed_left - 0.25);
85		86
86	$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 (!$arg) {
		122	my $ob = $pl->find_marked_object;
		123
		124	$pl->reply (undef, $ob
		125	? (sprintf "%s %s * is marked.", $ob->name, $ob->title)
		126	: "You have no marked object.");
		127	} else {
		128	my $ob = $pl->find_best_object_match ($arg);
		129
		130	return $pl->reply (undef, "Could not find an object that matches $arg")
		131	unless $ob;
		132
		133	$pl->contr->mark ($ob);
		134	$pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title));
		135	}
		136
		137	1
		138	};
		139
		140	cf::register_command who => sub {
		141	my ($ob, $arg) = @_;
		142
		143	$ob->speed_left ($ob->speed_left - 0.25);
		144
		145	$ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE \| cf::NDI_DK_ORANGE);
		146
		147	1
		148	};
		149
		150	for my $cmd ("run", "fire") {
		151	my $oncmd = "${cmd}_on";
		152	cf::register_command $cmd => sub {
		153	my ($ob, $arg) = @_;
		154
		155	return $ob->reply (undef, "Can't $cmd into a non adjacent square.")
		156	if $arg < 0 or $arg >= 9;
		157
		158	$ob->contr->$oncmd (1);
		159	$ob->move ($arg);
		160
		161	1
		162	};
		163
		164	cf::register_command "${cmd}_stop" => sub {
		165	my ($ob) = @_;
		166
		167	$ob->contr->$oncmd (0);
		168
		169	1
		170	};
		171	}
		172
		173	cf::register_command mapinfo => sub {
		174	my ($ob) = @_;
		175
		176	my $map = $ob->map
		177	or return;
		178	$ob->reply (undef, (sprintf "%s (%s) %s", $map->name, $map->path, $ob->region->longname));
		179	$ob->reply (undef, (sprintf "players: %d difficulty: %d size: %d start: %dx%d timeout: %d",
		180	$map->players, $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout))
		181	if $ob->flag (cf::FLAG_WIZ);
		182	$ob->reply (undef, $map->msg);
		183
		184	1
		185	};
		186
		187	cf::register_command whereami => sub {
		188	my ($ob) = @_;
		189
		190	my $reg = $ob->region;
		191	$ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg));
		192
		193	1
		194	};
		195
		196	cf::register_command applymode => sub {
		197	my ($ob, $arg) = @_;
		198	my @types = ("nochoice", "never", "always");
		199	my $mapping = {
		200	nochoice => 1,
		201	never => 2,
		202	always => 3,
		203	};
		204
		205	my $oldmode = $ob->contr->unapply;
		206	my $oldmode_name = $types[$oldmode];
		207
		208	return $ob->reply (undef, "applymode is set to $oldmode_name")
		209	unless $arg;
		210
		211	return $ob->reply (undef, "applymode: Unknown options '$arg', valid options are @types")
		212	unless $mapping->{$arg};
		213
		214	$ob->contr->unapply ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
		215	# but $arg would be 0 if a user enters an incorrect value
		216	$ob->reply (undef, "applymode" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $types[$ob->contr->unapply]);
		217
		218	1
		219	};
		220
		221	cf::register_command petmode => sub {
		222	my ($ob, $arg) = @_;
		223	my @types = ("normal", "sad", "defend", "arena");
		224	my $mapping = {
		225	normal => 1,
		226	sad => 2,
		227	defend => 3,
		228	arena => 4,
		229	};
		230
		231	my $oldtype = $ob->contr->petmode;
		232	my $oldtype_name = $types[$oldtype];
		233
		234	return $ob->reply (undef, "petmode is set to $oldtype_name")
		235	unless $arg;
		236
		237	return $ob->reply (undef, "petmode: Unknown options '$arg', valid options are @types")
		238	unless $mapping->{$arg};
		239
		240	$ob->contr->petmode ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
		241	# but $arg would be 0 if a user enters an incorrect value
		242	$ob->reply (undef, "petmode" . ($oldtype == $ob->contr->petmode ? "" : " now") . " set to " . $types[$ob->contr->petmode]);
		243
		244	1
		245	};
		246
		247	cf::register_command usekeys => sub {
		248	my ($ob, $arg) = @_;
		249	my @types = ("inventory", "keyrings", "containers");
		250	my $mapping = {
		251	inventory => 1,
		252	keyrings => 2,
		253	containers => 3,
		254	};
		255
		256	my $oldtype = $ob->contr->usekeys;
		257	my $oldtype_name = $types[$oldtype];
		258
		259	return $ob->reply (undef, "usekeys is set to $oldtype_name")
		260	unless $arg;
		261
		262	return $ob->reply (undef, "usekeys: Unknown options '$arg', valid options are @types")
		263	unless $mapping->{$arg};
		264
		265	$ob->contr->usekeys ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
		266	# but $arg would be 0 if a user enters an incorrect value
		267	$ob->reply (undef, "usekeys" . ($oldtype == $ob->contr->usekeys ? "" : " now") . " set to " . $types[$ob->contr->usekeys]);
		268
		269	1
		270	};
		271
		272	cf::register_command afk => sub {
		273	my ($ob, $arg) = @_;
		274
		275	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
		276	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
		277
		278	1
		279	};
		280
		281	cf::register_command sound => sub {
		282	my ($ob, $arg) = @_;
		283
		284	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
		285	$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
		286
		287	1
		288	};
		289
		290	cf::register_command brace => sub {
		291	my ($ob, $arg) = @_;
		292
		293	$ob->contr->braced ($ob->contr->braced ? 0 : 1);
		294	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
		295
		296	1
		297	};
		298
		299	cf::register_command 'output-count' => sub {
		300	my ($ob, $arg) = @_;
		301
		302	return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
		303	unless $arg > 0;
		304
		305	$ob->contr->outputs_count ($arg);
		306	$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
		307
		308	1
		309	};
		310
		311	cf::register_command 'output-sync' => sub {
		312	my ($ob, $arg) = @_;
		313
		314	return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync)
		315	unless $arg > 0;
		316
		317	$ob->contr->outputs_sync ($arg);
		318	$ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync);
		319
		320	1
		321	};
		322
		323	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
		324	# some other level (which may also be 0), this does not get echoed,
		325	# but it does get set.
		326	cf::register_command wimpy => sub {
		327	my ($ob, $arg) = @_;
		328
		329	my $wimpy = $ob->run_away;
		330	return $ob->reply (undef, "Your current wimpy level is $wimpy.")
		331	if $arg eq "";
		332
		333	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
		334	if $arg =~ /^\d+$/ and $arg <= 100;
		335
		336	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");
		337
		338	1
		339	};
		340
		341	cf::register_command peaceful => sub {
		342	my ($ob, $arg) = @_;
		343
		344	$ob->reply (undef, "You cannot change your peaceful setting with this command."
		345	." Please speak to the priest in the temple of Gorokh"
		346	." if you want to become hostile or in temple of Valriel"
		347	." if you want to become peaceful again.");
		348
		349	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
		350	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
87		351
88	1	352	1
89	};	353	};
90		354
91	cf::register_command rename => sub {	355	cf::register_command rename => sub {
…		…
122	$ob->reply (undef, "server started $startup, uptime ${runtime}\d");	386	$ob->reply (undef, "server started $startup, uptime ${runtime}\d");
123		387
124	1	388	1
125	};	389	};
126		390
		391	my %IN_MEMORY = (
		392	cf::MAP_IN_MEMORY => "I",
		393	cf::MAP_SWAPPED => "S",
		394	cf::MAP_LOADING => "L",
		395	);
		396
		397	cf::register_command maps => sub {
		398	my ($ob, $arg) = @_;
		399
		400	no re 'eval'; $arg = qr<$arg>;
		401
		402	my $format = "%2s %1s %3s %5s %.60s\n";
		403
		404	$ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK \| cf::NDI_UNIQUE);
		405
		406	for (sort keys %cf::MAP) {
		407	my $map = $cf::MAP{$_}
		408	or next;
		409
		410	next unless $map->path =~ $arg;
		411	next if $map->{deny_list};
		412
		413	my $svd = int $cf::RUNTIME - $map->{last_save};
		414	$svd = "++" if $svd > 99;
		415
		416	$ob->reply (undef,
		417	(sprintf $format,
		418	(scalar $map->players),
		419	$IN_MEMORY{$map->in_memory} \|\| "?",
		420	$svd,
		421	(int $map->reset_at - $cf::RUNTIME),
		422	$map->visible_name),
		423	cf::NDI_BLACK \| cf::NDI_UNIQUE);
		424	}
		425
		426	1
		427	};
		428

Diff Legend

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

Comparing deliantra/server/ext/commands.ext (file contents): Revision 1.4 by root, Thu Dec 21 23:37:05 2006 UTC vs. Revision 1.29 by pippijn, Fri Mar 2 12:16:55 2007 UTC

Diff Legend

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.4 by root, Thu Dec 21 23:37:05 2006 UTC vs.
Revision 1.29 by pippijn, Fri Mar 2 12:16:55 2007 UTC