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

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.6 by root, Sun Dec 31 17:17:22 2006 UTC vs.
Revision 1.34 by pippijn, Fri Mar 2 15:25:37 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
…		…
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	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	$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_player ($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	sub _set_mode($$$@) {
		197	my ($name, $ob, $arg, $slot, @choices) = @_;
		198
		199	my $oldmode = $ob->contr->$slot;
		200
		201	return $ob->reply (undef, "$name is set to $choices[$oldmode]")
		202	unless $arg;
		203
		204	my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices
		205	or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1;
		206
		207	$ob->contr->$slot ($idx);
		208	$ob->reply (undef, "$name" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $choices[$ob->contr->$slot]);
		209	}
		210
		211	cf::register_command applymode => sub {
		212	my ($ob, $arg) = @_;
		213
		214	_set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
		215
		216	1
		217	};
		218
		219	cf::register_command petmode => sub {
		220	my ($ob, $arg) = @_;
		221
		222	_set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
		223
		224	1
		225	};
		226
		227	cf::register_command usekeys => sub {
		228	my ($ob, $arg) = @_;
		229
		230	_set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
		231
		232	1
		233	};
		234
		235	cf::register_command afk => sub {
		236	my ($ob, $arg) = @_;
		237
		238	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
		239	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
		240
		241	1
		242	};
		243
		244	cf::register_command sound => sub {
		245	my ($ob, $arg) = @_;
		246
		247	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
		248	$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
		249
		250	1
		251	};
		252
		253	cf::register_command brace => sub {
		254	my ($ob, $arg) = @_;
		255
		256	$ob->contr->braced ($ob->contr->braced ? 0 : 1);
		257	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
		258
		259	1
		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	$ob->contr->outputs_count ($arg);
		269	$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
		270
		271	1
		272	};
		273
		274	cf::register_command 'output-sync' => sub {
		275	my ($ob, $arg) = @_;
		276
		277	return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync)
		278	unless $arg > 0;
		279
		280	$ob->contr->outputs_sync ($arg);
		281	$ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync);
		282
		283	1
		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	1
		302	};
		303
		304	cf::register_command peaceful => sub {
		305	my ($ob, $arg) = @_;
		306
		307	$ob->reply (undef, "You cannot change your peaceful setting with this command."
		308	." Please speak to the priest in the temple of Gorokh"
		309	." if you want to become hostile or in temple of Valriel"
		310	." if you want to become peaceful again.");
		311
		312	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
		313	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
88		314
89	1	315	1
90	};	316	};
91		317
92	cf::register_command rename => sub {	318	cf::register_command rename => sub {
…		…
123	$ob->reply (undef, "server started $startup, uptime ${runtime}\d");	349	$ob->reply (undef, "server started $startup, uptime ${runtime}\d");
124		350
125	1	351	1
126	};	352	};
127		353
		354	my %IN_MEMORY = (
		355	cf::MAP_IN_MEMORY => "I",
		356	cf::MAP_SWAPPED => "S",
		357	cf::MAP_LOADING => "L",
		358	);
		359
		360	cf::register_command maps => sub {
		361	my ($ob, $arg) = @_;
		362
		363	no re 'eval'; $arg = qr<$arg>;
		364
		365	my $format = "%2s %1s %3s %5s %.60s\n";
		366
		367	$ob->reply (undef, (sprintf $format, "Pl", "I", "Svd", "Reset", "Name"), cf::NDI_BLACK \| cf::NDI_UNIQUE);
		368
		369	for (sort keys %cf::MAP) {
		370	my $map = $cf::MAP{$_}
		371	or next;
		372
		373	next unless $map->path =~ $arg;
		374	next if $map->{deny_list};
		375
		376	my $svd = int $cf::RUNTIME - $map->{last_save};
		377	$svd = "++" if $svd > 99;
		378
		379	$ob->reply (undef,
		380	(sprintf $format,
		381	(scalar $map->players),
		382	$IN_MEMORY{$map->in_memory} \|\| "?",
		383	$svd,
		384	(int $map->reset_at - $cf::RUNTIME),
		385	$map->visible_name),
		386	cf::NDI_BLACK \| cf::NDI_UNIQUE);
		387	}
		388
		389	1
		390	};
		391

Diff Legend

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

Comparing deliantra/server/ext/commands.ext (file contents): Revision 1.6 by root, Sun Dec 31 17:17:22 2006 UTC vs. Revision 1.34 by pippijn, Fri Mar 2 15:25:37 2007 UTC

Diff Legend

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.6 by root, Sun Dec 31 17:17:22 2006 UTC vs.
Revision 1.34 by pippijn, Fri Mar 2 15:25:37 2007 UTC