[ViewVC] Diff of: cvs/deliantra/maps/perl/chat.ext

Comparing deliantra/maps/perl/chat.ext (file contents):
Revision 1.13 by pippijn, Sun May 7 19:51:50 2006 UTC vs.
Revision 1.28 by root, Sun Jul 30 19:58:29 2006 UTC

…		…
1	#! perl	1	#! perl
2		2
3	# implement a replacement for the built-in chat/shout/tell/reply commands	3	# implement a replacement for the built-in say/chat/shout/tell/reply commands
4	# adds ignore/unignore functionality	4	# adds ignore/unignore functionality
5		5
6	sub valid_user($) {	6	use NPC_Dialogue;
7	-f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;	7	use POSIX (); # for strftime only
8	}
9		8
10	sub clean_timeouts($) {	9	sub clean_timeouts($) {
11	my ($player) = @_;	10	my ($player) = @_;
12	my $NOW = time;	11	my $NOW = time;
13		12
14	for my $hash (@$player{qw(ext_ignore_shout ext_ignore_tell)}) {	13	for my $hash (@$player{qw(ext_ignore_shout ext_ignore_tell)}) {
15	while (my ($k, $v) = each %$hash) {	14	while (my ($k, $v) = each %$hash) {
16	if ($v < $NOW) {	15	if ($v < $NOW) {
17	$player->message ("Your ignore on $k has expired.", cf::NDI_GREEN);	16	$player->message ("Your ignore on $k has expired.", cf::NDI_GREEN \| cf::NDI_UNIQUE);
18	delete $hash->{$k};	17	delete $hash->{$k};
19	} elsif (!valid_user $k) {	18	} elsif (!cf::player::exists $k) {
20	$player->message ("Your ignore on $k is no longer valid (no such user).", cf::NDI_GREEN);	19	$player->message ("Your ignore on $k is no longer valid (no such user).", cf::NDI_GREEN \| cf::NDI_UNIQUE);
21	delete $hash->{$k};	20	delete $hash->{$k};
22	}	21	}
23	}	22	}
24	}	23	}
25	}	24	}
28	my ($pl, $host) = @_;	27	my ($pl, $host) = @_;
29		28
30	clean_timeouts $pl->ob;	29	clean_timeouts $pl->ob;
31	}	30	}
32		31
		32	cf::register_command listen => 0, sub {
		33	my ($who, $msg) = @_;
		34	my $player = cf::player::find $who->name;
		35
		36	if ($msg ne "") {
		37	my $prev_listen = $player->listening;
		38	$player->listening ($msg);
		39	if ($prev_listen == $player->listening) {
		40	$who->message ("Your verbose level stayed $prev_listen.", cf::NDI_UNIQUE);
		41	} else {
		42	$who->message ("Your verbose level is now " . $player->listening . ". (previously: $prev_listen)", cf::NDI_UNIQUE);
		43	}
		44	} else {
		45	$who->message ("Your verbose level is " . $player->listening . ".", cf::NDI_UNIQUE);
		46	}
		47	};
		48
		49	cf::register_command say => 0, sub {
		50	my ($who, $msg) = @_;
		51
		52	utf8::decode $msg;
		53
		54	if ($msg) {
		55	my $name = $who->name;
		56
		57	utf8::encode $msg; # ->message not yet utf8-ified
		58	$_->ob->message ("$name says: $msg", cf::NDI_GREY \| cf::NDI_UNIQUE)
		59	for grep $who->on_same_map_as ($_->ob), cf::player::list;
		60	utf8::decode $msg;
		61
		62	# npcs, magic_ears etc.
		63	# first find all objects and their inventories within a 5x5 square
		64	# that have something resembling dialogue
		65	my ($map, $x, $y) = ($who->map, $who->x - 2, $who->y - 2);
		66
		67	for my $npc (
		68	grep NPC_Dialogue::has_dialogue $_,
		69	map +($_, $_->inv),
		70	grep $_,
		71	map $map->at ($x + $_ % 5, $y + (int $_ / 5)),
		72	0..24
		73	) {
		74	# if some listener teleported us somewhere else, stop right here
		75	last unless $map->path == $who->map->path;
		76
		77	my $dialog = new NPC_Dialogue ob => $who, npc => $npc;
		78	my ($reply, @kw) = $dialog->tell ($msg);
		79
		80	if (defined $reply) {
		81	if ($npc->type == cf::MAGIC_EAR) {
		82	if (length $reply) {
		83	$_->ob->message ($reply, cf::NDI_BROWN \| cf::NDI_UNIQUE)
		84	for grep $who->on_same_map_as ($_->ob), cf::player::list;
		85	}
		86	$npc->use_trigger;
		87	} else {
		88	if (length $reply) {
		89	$_->ob->message ($npc->name . " says: $reply", cf::NDI_BROWN \| cf::NDI_UNIQUE)
		90	for grep $who->on_same_map_as ($_->ob), cf::player::list;
		91	}
		92	}
		93	}
		94
		95	if (@kw) {
		96	$_->ob->message ("[further topics: " . (join ", ", @kw) . "]", cf::NDI_BROWN \| cf::NDI_UNIQUE)
		97	for grep $who->on_same_map_as ($_->ob), cf::player::list;
		98	}
		99	}
		100
		101	} else {
		102	$who->message ("What do you want to say?", cf::NDI_UNIQUE);
		103	}
		104	};
		105
33	cf::register_command chat => 0, sub {	106	cf::register_command chat => 0, sub {
34	my ($who, $msg) = @_;	107	my ($who, $msg) = @_;
		108
		109	utf8::decode $msg;
35		110
36	if ($msg) {	111	if ($msg) {
37	my $name = $who->name;	112	my $name = $who->name;
38	my $NOW = time;	113	my $NOW = time;
39		114
		115	utf8::encode $msg; # ->message not yet utf8-ified
		116	cf::LOG cf::llevDebug, sprintf "QBERT [%s] %s\n", $name, $msg;
		117
40	$_->ob->message ("$name chats: $msg", cf::NDI_BLUE)	118	$_->ob->message ("$name chats: $msg", cf::NDI_BLUE)
41	for grep { $_->ob->{ext_ignore_shout}{$name} and $_->listening >= 10 } < $NOW, cf::player::list;	119	for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW && $_->listening >= 10 } cf::player::list;
42		120
43	} else {	121	} else {
44	$who->message ("Chat what?", cf::NDI_UNIQUE);	122	$who->message ("Chat what?", cf::NDI_UNIQUE);
45	}	123	}
46	};	124	};
47		125
48	cf::register_command shout => 0, sub {	126	cf::register_command shout => 0, sub {
49	my ($who, $msg) = @_;	127	my ($who, $msg) = @_;
		128
		129	utf8::decode $msg;
50		130
51	if ($msg) {	131	if ($msg) {
52	my $NOW = time;	132	my $NOW = time;
53	my $name = $who->name;	133	my $name = $who->name;
54		134
		135	cf::LOG cf::llevDebug, sprintf "QBERT {%s} %s\n", $name, $msg;
		136
		137	utf8::encode $msg; # ->message not yet utf8-ified
55	$_->ob->message ("$name shouts: $msg", cf::NDI_RED)	138	$_->ob->message ("$name shouts: $msg", cf::NDI_RED)
56	for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW and $_->listening >= 2 }, cf::player::list;	139	for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW && $_->listening >= 2 } cf::player::list;
57		140
58	} else {	141	} else {
59	$who->message ("Shout what?", cf::NDI_UNIQUE);	142	$who->message ("Shout what?", cf::NDI_UNIQUE);
60	}	143	}
61		144
62	};	145	};
63		146
64	cf::register_command tell => 0, sub {	147	cf::register_command tell => 0, sub {
65	my ($who, $args) = @_;	148	my ($who, $args) = @_;
66	my ($target, $msg) = split /\s+/, $args, 2;	149	my ($target, $msg) = split /\s+/, $args, 2;
		150
		151	utf8::decode $msg;
67		152
68	my $name = $who->name;	153	my $name = $who->name;
69		154
70	if (my $other = cf::player::find $target) {	155	if (my $other = cf::player::find $target) {
71		156
…		…
73	if ($target eq $name) {	158	if ($target eq $name) {
74	$who->message ("You are talking to yourself, you freak!", cf::NDI_UNIQUE);	159	$who->message ("You are talking to yourself, you freak!", cf::NDI_UNIQUE);
75	} elsif ($other->ob->{ext_ignore_tell}{$name} >= time) {	160	} elsif ($other->ob->{ext_ignore_tell}{$name} >= time) {
76	$who->message ("$target ignores what you say. Give up on it.", cf::NDI_UNIQUE);	161	$who->message ("$target ignores what you say. Give up on it.", cf::NDI_UNIQUE);
77	} else {	162	} else {
		163	utf8::encode $msg; # ->message not yet utf8-ified
		164	cf::LOG cf::llevDebug, sprintf "TELL [%s>%s] %s\n", $name, $target, $msg;
		165
78	$who->message ("You tell $target: $msg");	166	$who->message ("You tell $target: $msg");
79	$other->ob->message ("$name tells you: $msg");	167	$other->ob->message ("$name tells you: $msg");
80	$other->ob->{ext_last_tell} = $name;	168	$other->ob->{ext_last_tell} = $name;
81	}	169	}
82	} else {	170	} else {
…		…
90		178
91	cf::register_command reply => 0, sub {	179	cf::register_command reply => 0, sub {
92	my ($who, $args) = @_;	180	my ($who, $args) = @_;
93	my $name = $who->name;	181	my $name = $who->name;
94		182
		183	utf8::decode $args;
		184
95	if (my $other = cf::player::find $who->{ext_last_tell}) {	185	if (my $other = cf::player::find $who->{ext_last_tell}) {
96	if ($args) {	186	if ($args) {
97		187
98	$other->ob->{ext_ignore_tell}{$name} >= time	188	$other->ob->{ext_ignore_tell}{$name} >= time
99	or delete $other->ob->{ext_ignore_tell}{$name};	189	or delete $other->ob->{ext_ignore_tell}{$name};
100		190
101	if ($other->ob->{ext_ignore_tell}{$name} < time) {	191	if ($other->ob->{ext_ignore_tell}{$name} < time) {
		192	utf8::encode $args; # ->message not yet utf8-ified
		193	cf::LOG cf::llevDebug, sprintf "TELL [%s>%s] %s\n", $name, $other->ob->name, $args;
		194
102	$who->message ("You tell " . $other->ob->name . ": $args");	195	$who->message ("You tell " . $other->ob->name . ": $args");
103	$other->ob->message ("$name tells you: $args");	196	$other->ob->message ("$name tells you: $args");
104	$who->{ext_last_tell} = $other->ob->name;	197	$who->{ext_last_tell} = $other->ob->name;
105	} else {	198	} else {
106	$who->message ($other->ob->name . " ignores what you say. Give up on it.", cf::NDI_UNIQUE);	199	$who->message ($other->ob->name . " ignores what you say. Give up on it.", cf::NDI_UNIQUE);
…		…
135	} elsif ($target && $type) {	228	} elsif ($target && $type) {
136		229
137	$timeout ne "" or $timeout = 24;	230	$timeout ne "" or $timeout = 24;
138	my $absolute_timeout = time + $timeout * 3600;	231	my $absolute_timeout = time + $timeout * 3600;
139		232
140	if (valid_user $target) {	233	if (cf::player::exists $target) {
141	if ($type eq "tell") {	234	if ($type eq "tell") {
142	$who->message ("Now ignoring private messages from $target for $timeout hours.", cf::NDI_UNIQUE);	235	$who->message ("Now ignoring private messages from $target for $timeout hours.", cf::NDI_UNIQUE);
143	$who->{ext_ignore_tell}{$target} = $absolute_timeout;	236	$who->{ext_ignore_tell}{$target} = $absolute_timeout;
144	} elsif ($type eq "shout") {	237	} elsif ($type eq "shout") {
145	$who->message ("Now ignoring shouts from $target for $timeout hours.", cf::NDI_UNIQUE);	238	$who->message ("Now ignoring shouts from $target for $timeout hours.", cf::NDI_UNIQUE);
…		…
154	} else {	247	} else {
155	$who->message ("No such player: $target", cf::NDI_UNIQUE);	248	$who->message ("No such player: $target", cf::NDI_UNIQUE);
156	}	249	}
157		250
158	} else {	251	} else {
159	$who->message ("Usage: ignore <player> <tell \| shout \| all> <timeout>\n"	252	$who->message ("Usage: ignore <player> <tell\|shout\|all> <timeout>\n"
160	. "will ignore a player for <timeout> hours.\n"	253	. "will ignore a player for <timeout> hours.\n"
161	. "Usage: ignore list\n"	254	. "Usage: ignore list\n"
162	. "will show you a list of players currently ignored.", cf::NDI_UNIQUE);	255	. "will show you a list of players currently ignored.", cf::NDI_UNIQUE);
163	}	256	}
164	};	257	};
…		…
175	$who->message ((join ", ", sort keys %{ $who->{ext_ignore_shout} }), cf::NDI_UNIQUE);	268	$who->message ((join ", ", sort keys %{ $who->{ext_ignore_shout} }), cf::NDI_UNIQUE);
176	} else {	269	} else {
177	$who->message ("Not ignoring anyone", cf::NDI_UNIQUE);	270	$who->message ("Not ignoring anyone", cf::NDI_UNIQUE);
178	}	271	}
179	} else {	272	} else {
180		273	if (cf::player::exists $target) {
181	if (valid_user $target) {
182	if ($type eq "tell") {	274	if ($type eq "tell") {
183	$who->message ("Not ignoring private messages from $target anymore.", cf::NDI_UNIQUE);	275	$who->message ("Not ignoring private messages from $target anymore.", cf::NDI_UNIQUE);
184	delete $who->{ext_ignore_tell} {$target};	276	delete $who->{ext_ignore_tell} {$target};
185	} elsif ($type eq "shout") {	277	} elsif ($type eq "shout") {
186	$who->message ("Not ignoring shouts from $target anymore.", cf::NDI_UNIQUE);	278	$who->message ("Not ignoring shouts from $target anymore.", cf::NDI_UNIQUE);
…		…
193	$who->message ("You need to specify tell, shout or all.", cf::NDI_UNIQUE);	285	$who->message ("You need to specify tell, shout or all.", cf::NDI_UNIQUE);
194	}	286	}
195	} else {	287	} else {
196	$who->message ("No such player or ambiguous name: $target", cf::NDI_UNIQUE);	288	$who->message ("No such player or ambiguous name: $target", cf::NDI_UNIQUE);
197	}	289	}
198
199	}	290	}
200	};	291	};
201		292
		293	cf::register_command seen => 0, sub {
		294	my ($who, $args) = @_;
		295
		296	if (my ($login) = $args =~ /(\S+)/) {
		297	if ($login eq $who->name) {
		298	$who->message ("Very funny, $login. Ha. Ha.", cf::NDI_UNIQUE);
		299	} elsif (cf::player::find $login) {
		300	$who->message ("$login is right here on this server!", cf::NDI_UNIQUE);
		301	} elsif (cf::player::exists $login
		302	and stat sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($login) x 2) {
		303	my $time = (stat _)[9];
		304
		305	$who->message ("$login was last seen here "
		306	. (POSIX::strftime "%Y-%m-%d %H:%M:%S +0000", gmtime $time)
		307	. " which was " . (int +(time - $time) / 3600) . " hours ago.", cf::NDI_UNIQUE);
		308	} else {
		309	$who->message ("No player named $login is known to me.", cf::NDI_UNIQUE);
		310	}
		311	} else {
		312	$who->message ("Usage: seen <player>", cf::NDI_UNIQUE);
		313	}
		314	};
		315

Diff Legend

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

Comparing deliantra/maps/perl/chat.ext (file contents): Revision 1.13 by pippijn, Sun May 7 19:51:50 2006 UTC vs. Revision 1.28 by root, Sun Jul 30 19:58:29 2006 UTC

Diff Legend

Comparing deliantra/maps/perl/chat.ext (file contents):
Revision 1.13 by pippijn, Sun May 7 19:51:50 2006 UTC vs.
Revision 1.28 by root, Sun Jul 30 19:58:29 2006 UTC