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

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.20 by pippijn, Fri Mar 2 10:15:38 2007 UTC vs.
Revision 1.48 by root, Sun Jun 24 01:09:27 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->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->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);
		237
		238	1
		239	};
		240
		241	cf::register_command usekeys => sub {
		242	my ($ob, $arg) = @_;
		243
		244	_set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
88		245
89	1	246	1
90	};	247	};
91		248
92	cf::register_command afk => sub {	249	cf::register_command afk => sub {
93	my ($ob, $arg) = @_;	250	my ($ob, $arg) = @_;
94		251
95	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);	252	$ob->contr->ns->afk ($ob->contr->ns->afk ? 0 : 1);
96	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");	253	$ob->reply (undef, $ob->contr->ns->afk ? "You are now AFK" : "You are no longer AFK");
		254
		255	1
		256	};
		257
		258	cf::register_command sound => sub {
		259	my ($ob, $arg) = @_;
		260
		261	$ob->contr->ns->sound ($ob->contr->ns->sound ? 0 : 1);
		262	$ob->reply (undef, $ob->contr->ns->sound ? "The sounds are enabled." : "Silence is golden...");
		263
		264	1
97	};	265	};
98		266
99	cf::register_command brace => sub {	267	cf::register_command brace => sub {
100	my ($ob, $arg) = @_;	268	my ($ob, $arg) = @_;
101		269
102	$ob->contr->braced ($ob->contr->braced ? 0 : 1);	270	$ob->contr->braced ($ob->contr->braced ? 0 : 1);
103	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");	271	$ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
		272
		273	1
		274	};
		275
		276	cf::register_command 'output-rate' => sub {
		277	my ($ob, $arg) = @_;
		278
		279	return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK)
		280	unless $arg > 0;
		281
		282	# minimum is 2k/s
		283	$ob->contr->ns->max_rate ((List::Util::max 2048, $arg) * $cf::TICK);
		284	$ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK);
		285
		286	1
		287	};
		288
		289	cf::register_command 'output-count' => sub {
		290	my ($ob, $arg) = @_;
		291
		292	return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
		293	unless $arg > 0;
		294
		295	$arg = 4 if $arg < 4;
		296
		297	$ob->contr->outputs_count ($arg);
		298	$ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
		299
		300	1
		301	};
		302
		303	cf::register_command 'output-sync' => sub {
		304	my ($ob, $arg) = @_;
		305
		306	return $ob->reply (undef, sprintf "Output sync time is presently %.1fs", $ob->contr->outputs_sync * $cf::TICK)
		307	unless length $arg;
		308
		309	$arg = 0.5 if $arg < 0.5;
		310
		311	$ob->contr->outputs_sync ($arg / $cf::TICK);
		312	$ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK);
		313
		314	1
104	};	315	};
105		316
106	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to	317	# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to
107	# some other level (which may also be 0), this does not get echoed,	318	# some other level (which may also be 0), this does not get echoed,
108	# but it does get set.	319	# but it does get set.
…		…
115		326
116	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")	327	return $ob->run_away ($arg) && $ob->reply (undef, "Your new wimpy level is $arg.")
117	if $arg =~ /^\d+$/ and $arg <= 100;	328	if $arg =~ /^\d+$/ and $arg <= 100;
118		329
119	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");	330	$ob->reply (undef, "Incorrect parameters for wimpy: $arg");
		331
		332	1
120	};	333	};
121		334
122	cf::register_command peaceful => sub {	335	cf::register_command peaceful => sub {
123	my ($ob, $arg) = @_;	336	my ($ob, $arg) = @_;
124		337
…		…
127	." if you want to become hostile or in temple of Valriel"	340	." if you want to become hostile or in temple of Valriel"
128	." if you want to become peaceful again.");	341	." if you want to become peaceful again.");
129		342
130	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);	343	#$ob->contr->peaceful ($ob->contr->peaceful ? 0 : 1);
131	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");	344	#$ob->reply (undef, $ob->contr->peaceful ? "You will attack other players." : "You will not attack other players.");
132	};
133		345
		346	1
		347	};
134		348
135	cf::register_command rename => sub {	349	cf::register_command rename => sub {
136	my ($ob, $arg) = @_;	350	my ($ob, $arg) = @_;
137		351
138	$ob->speed_left ($ob->speed_left - 0.25);	352	$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.20 by pippijn, Fri Mar 2 10:15:38 2007 UTC vs. Revision 1.48 by root, Sun Jun 24 01:09:27 2007 UTC

Diff Legend

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.20 by pippijn, Fri Mar 2 10:15:38 2007 UTC vs.
Revision 1.48 by root, Sun Jun 24 01:09:27 2007 UTC