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

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.21 by pippijn, Fri Mar 2 10:43:01 2007 UTC vs.
Revision 1.51 by root, Tue Jul 3 00:54:44 2007 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		6
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
…		…
36	$ob->esrv_update_item (cf::UPD_NAME, $item);	36	$ob->esrv_update_item (cf::UPD_NAME, $item);
37		37
38	1	38	1
39	}	39	}
40		40
41	sub ext::schmorp_irc::users; # HACK: TODO: replace by signal
42
43	sub who_listing(;$) {	41	sub who_listing(;$$) {
44	my ($privileged) = @_;	42	my ($privileged, $select) = @_;
45		43
46	my ($numwiz, $numafk) = (0, 0);	44	my ($numwiz, $numafk) = (0, 0);
47	my @pl;	45	my @pl;
48		46
49	foreach my $pl (cf::player::list) {	47	foreach my $pl (cf::player::list) {
…		…
59	push @pl, $pl;	57	push @pl, $pl;
60	}	58	}
61		59
62	(	60	(
63	"Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)",	61	"Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)",
64	(	62	(grep /$select/,
65	map {	63	map {
66	my ($pl, $ob, $ns) = ($_, $_->ob, $_->ns);	64	my ($pl, $ob, $ns) = ($_, $_->ob, $_->ns);
67		65
68	"* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)	66	"* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
		67	. ($pl->gender ? " [f]" : " [m]")
69	. ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")	68	. ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
70	. ($ns->afk ? " [AFK]" : "")	69	. ($ns->afk ? " [AFK]" : "")
71	. ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")	70	. ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
72	. " [" . $pl->ns->version . "]"	71	. " [" . $pl->ns->version . "]"
73	. " [" . ($pl->peaceful \|\| $privileged ? $ob->map->visible_name : $ob->region->name) . "]"	72	. " [" . ($pl->peaceful \|\| $privileged ? $ob->map->visible_name : $ob->region->name) . "]"
74	. (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6)	73	. (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6)
75	. ($privileged ? " " . $pl->ns->host : "")	74	. ($privileged ? " " . $pl->ns->host : "")
76	} sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl	75	} sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
77	),	76	),
78	eval { "* IRC: " . join ", ", ext::schmorp_irc::users },	77	eval { "* IRC: " . join ", ", ext::irc::users },
79	)	78	)
80	}	79	}
81		80
82	cf::register_command who => sub {	81	cf::register_command who => sub {
83	my ($ob, $arg) = @_;	82	my ($ob, $arg) = @_;
84		83
85	$ob->speed_left ($ob->speed_left - 0.25);	84	$ob->speed_left ($ob->speed_left - 4);
86		85
87	$ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE \| cf::NDI_DK_ORANGE);	86	$ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who"), $arg), cf::NDI_UNIQUE \| cf::NDI_DK_ORANGE);
		87
		88	1
		89	};
		90
		91	cf::register_command seen => sub {
		92	my ($pl, $args) = @_;
		93
		94	if (my ($login) = $args =~ /(\S+)/) {
		95	if ($login eq $pl->name) {
		96	$pl->message ("Very funny, $login. Ha. Ha.", cf::NDI_UNIQUE);
		97	} elsif (cf::player::find_active $login) {
		98	$pl->message ("$login is right here on this server!", cf::NDI_UNIQUE);
		99	} elsif (cf::player::exists $login
		100	and stat cf::player::path $login) {
		101	my $time = (stat _)[9];
		102
		103	$pl->message ("$login was last seen here "
		104	. (POSIX::strftime "%Y-%m-%d %H:%M:%S +0000", gmtime $time)
		105	. " which was " . (int +(time - $time) / 3600) . " hours ago.", cf::NDI_UNIQUE);
		106	} else {
		107	$pl->message ("No player named $login is known to me.", cf::NDI_UNIQUE);
		108	}
		109	} else {
		110	$pl->message ("Usage: seen <player>", cf::NDI_UNIQUE);
		111	}
		112	};
		113
		114	cf::register_command body => sub {
		115	my ($ob) = @_;
		116
		117	# Too hard to try and make a header that lines everything up, so just
		118	# give a description. (comment from C++)
		119	my $reply =
		120	"The first column is the name of the body location.\n"
		121	. "The second column is how many of those locations your body has.\n"
		122	. "The third column is how many slots in that location are available.\n";
		123
		124	$reply .= sprintf "%-20s %3s %5s\n", "Location", "You", "Avail";
		125	for (0 .. cf::NUM_BODY_LOCATIONS - 1) {
		126	my $msg = cf::object::slot_nonuse_name $_;
		127	$msg =~ s/^.*? a //;
		128	$reply .= sprintf "%-20s %3d %5d\n", $msg, $ob->slot_info ($_), $ob->slot_used ($_)
		129	if $ob->slot_info ($_) or $ob->slot_used ($_);
		130	}
		131
		132	$reply .= "You are not allowed to wear armor\n"
		133	unless $ob->flag (cf::FLAG_USE_ARMOUR);
		134	$reply .= "You are not allowed to use weapons\n"
		135	unless $ob->flag (cf::FLAG_USE_WEAPON);
		136
		137	$ob->reply (undef, $reply);
		138
		139	1
		140	};
		141
		142	cf::register_command mark => sub {
		143	my ($pl, $arg) = @_;
		144
		145	if (length $arg) {
		146	my $ob = $pl->find_best_object_match ($arg);
		147
		148	return $pl->reply (undef, "Could not find an object that matches $arg")
		149	unless $ob;
		150
		151	$pl->contr->mark ($ob);
		152	$pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title));
		153	} else {
		154	my $ob = $pl->find_marked_object;
		155
		156	$pl->reply (undef, $ob
		157	? (sprintf "%s %s * is marked.", $ob->name, $ob->title)
		158	: "You have no marked object.");
		159	}
		160
		161	1
		162	};
		163
		164	for my $cmd ("run", "fire") {
		165	my $oncmd = "${cmd}_on";
		166	cf::register_command $cmd => sub {
		167	my ($ob, $arg) = @_;
		168
		169	$ob->reply (undef, "Can't $cmd into a non adjacent square.")
		170	if $arg < 0 or $arg >= 9;
		171
		172	$ob->contr->$oncmd (1);
		173	$ob->move_player ($arg);
		174
		175	1
		176	};
		177
		178	cf::register_command "${cmd}_stop" => sub {
		179	my ($ob) = @_;
		180
		181	$ob->contr->$oncmd (0);
		182
		183	1
		184	};
		185	}
		186
		187	cf::register_command mapinfo => sub {
		188	my ($ob) = @_;
		189
		190	my $map = $ob->contr->observe->map
		191	or return;
		192	$ob->reply (undef, (sprintf "%s (%s) %s", $map->name, $map->path, $ob->region->longname));
		193	$ob->reply (undef, (sprintf "players: %d difficulty: %d size: %d start: %dx%d timeout: %d",
		194	$map->players, $map->difficulty, $map->width, $map->height, $map->enter_x, $map->enter_y, $map->timeout))
		195	if $ob->flag (cf::FLAG_WIZ);
		196	$ob->reply (undef, $map->msg);
		197
		198	1
		199	};
		200
		201	cf::register_command whereami => sub {
		202	my ($ob) = @_;
		203
		204	my $reg = $ob->contr->observe->region;
		205	$ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg));
		206
		207	1
		208	};
		209
		210	sub _set_mode($$$@) {
		211	my ($name, $ob, $arg, $slot, @choices) = @_;
		212
		213	my $oldmode = $ob->contr->$slot;
		214
		215	return $ob->reply (undef, "$name is set to $choices[$oldmode]")
		216	unless $arg;
		217
		218	my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices
		219	or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1;
		220
		221	$ob->contr->$slot ($idx);
		222	$ob->reply (undef, "$name" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $choices[$ob->contr->$slot]);
		223	}
		224
		225	cf::register_command applymode => sub {
		226	my ($ob, $arg) = @_;
		227
		228	_set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
		229
		230	1
		231	};
		232
		233	cf::register_command petmode => sub {
		234	my ($ob, $arg) = @_;
		235
		236	_set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
88		237
89	1	238	1
90	};	239	};
91		240
92	cf::register_command usekeys => sub {	241	cf::register_command usekeys => sub {
93	my ($ob, $arg) = @_;	242	my ($ob, $arg) = @_;
94	my @types = ("inventory", "keyrings", "containers");
95	my $mapping = {
96	inventory => 1,
97	keyrings => 2,
98	containers => 3,
99	};
100		243
101	my $oldtype = $ob->contr->usekeys;	244	_set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
102	my $oldtype_name = $types[$oldtype];
103		245
104	return $ob->reply (undef, "usekeys is set to $oldtype_name")	246	1
105	unless $arg;	247	};
106		248
107	return $ob->reply (undef, "usekeys: Unknown options '$arg', valid options are inventory, keyrings, containers")	249	cf::register_command hintmode => sub {
108	unless $mapping->{$arg};	250	my ($ob, $arg) = @_;
109		251
110	$ob->contr->usekeys ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0	252	_set_mode "hintmode", $ob, $arg, hintmode => qw(show mark hide);
111	# but $arg would be 0 if a user enters an incorrect value	253
112	$ob->reply (undef, "usekeys" . ($oldtype == $ob->contr->usekeys ? "" : " now") . " set to " . $types[$ob->contr->usekeys]);	254	1
113	};	255	};
114		256
115	cf::register_command afk => sub {	257	cf::register_command afk => sub {
116	my ($ob, $arg) = @_;	258	my ($ob, $arg) = @_;
117		259
118	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);	260	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
119	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");	261	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
		262
		263	1
120	};	264	};
121		265
122	cf::register_command sound => sub {	266	cf::register_command sound => sub {
123	my ($ob, $arg) = @_;	267	my ($ob, $arg) = @_;
124		268
125	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);	269	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
126	$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");	270	$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
		271
		272	1
127	};	273	};
128		274
129	cf::register_command brace => sub {	275	cf::register_command brace => sub {
130	my ($ob, $arg) = @_;	276	my ($ob, $arg) = @_;
131		277
132	$ob->contr->braced ($ob->contr->braced ? 0 : 1);	278	$ob->contr->braced ($ob->contr->braced ? 0 : 1);
133	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");	279	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
		280
		281	1
		282	};
		283
		284	cf::register_command 'output-rate' => sub {
		285	my ($ob, $arg) = @_;
		286
		287	return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK)
		288	unless $arg > 0;
		289
		290	# minimum is 2k/s
		291	$ob->contr->ns->max_rate ((List::Util::max 2048, $arg) * $cf::TICK);
		292	$ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK);
		293
		294	1
		295	};
		296
		297	cf::register_command 'output-count' => sub {
		298	my ($ob, $arg) = @_;
		299
		300	return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
		301	unless $arg > 0;
		302
		303	$arg = 4 if $arg < 4;
		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, sprintf "Output sync time is presently %.1fs", $ob->contr->outputs_sync * $cf::TICK)
		315	unless length $arg;
		316
		317	$arg = 0.5 if $arg < 0.5;
		318
		319	$ob->contr->outputs_sync ($arg / $cf::TICK);
		320	$ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK);
		321
		322	1
134	};	323	};
135		324
136	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to	325	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
137	# some other level (which may also be 0), this does not get echoed,	326	# some other level (which may also be 0), this does not get echoed,
138	# but it does get set.	327	# but it does get set.
…		…
145		334
146	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")	335	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
147	if $arg =~ /^\d+$/ and $arg <= 100;	336	if $arg =~ /^\d+$/ and $arg <= 100;
148		337
149	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");	338	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");
		339
		340	1
150	};	341	};
151		342
152	cf::register_command peaceful => sub {	343	cf::register_command peaceful => sub {
153	my ($ob, $arg) = @_;	344	my ($ob, $arg) = @_;
154		345
…		…
157	." if you want to become hostile or in temple of Valriel"	348	." if you want to become hostile or in temple of Valriel"
158	." if you want to become peaceful again.");	349	." if you want to become peaceful again.");
159		350
160	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);	351	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
161	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");	352	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
162	};
163		353
		354	1
		355	};
164		356
165	cf::register_command rename => sub {	357	cf::register_command rename => sub {
166	my ($ob, $arg) = @_;	358	my ($ob, $arg) = @_;
167		359
168	$ob->speed_left ($ob->speed_left - 0.25);	360	$ob->speed_left ($ob->speed_left - 0.25);

Diff Legend

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

Comparing deliantra/server/ext/commands.ext (file contents): Revision 1.21 by pippijn, Fri Mar 2 10:43:01 2007 UTC vs. Revision 1.51 by root, Tue Jul 3 00:54:44 2007 UTC

Diff Legend

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.21 by pippijn, Fri Mar 2 10:43:01 2007 UTC vs.
Revision 1.51 by root, Tue Jul 3 00:54:44 2007 UTC