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

Comparing deliantra/maps/perl/chat.ext (file contents):
Revision 1.12 by root, Sun May 7 11:23:43 2006 UTC vs.
Revision 1.32 by root, Fri Aug 25 13:33:57 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	}
26		25
27	sub on_logout {	26	cf::attach_to_players
		27	prio => -1000,
		28	on_login => sub {
28	my ($pl, $host) = @_;	29	my ($pl) = @_;
29		30
30	clean_timeouts $pl->ob;	31	clean_timeouts $pl->ob;
31	}	32	},
		33	;
		34
		35	cf::register_command listen => 0, sub {
		36	my ($who, $msg) = @_;
		37	my $player = cf::player::find $who->name;
		38
		39	if ($msg ne "") {
		40	my $prev_listen = $player->listening;
		41	$player->listening ($msg);
		42	if ($prev_listen == $player->listening) {
		43	$who->message ("Your verbose level stayed $prev_listen.", cf::NDI_UNIQUE);
		44	} else {
		45	$who->message ("Your verbose level is now " . $player->listening . ". (previously: $prev_listen)", cf::NDI_UNIQUE);
		46	}
		47	} else {
		48	$who->message ("Your verbose level is " . $player->listening . ".", cf::NDI_UNIQUE);
		49	}
		50	};
		51
		52	cf::register_command say => 0, sub {
		53	my ($who, $msg) = @_;
		54
		55	utf8::decode $msg;
		56
		57	if ($msg) {
		58	my $name = $who->name;
		59
		60	utf8::encode $msg; # ->message not yet utf8-ified
		61	$_->ob->message ("$name says: $msg", cf::NDI_GREY \| cf::NDI_UNIQUE)
		62	for grep $who->on_same_map_as ($_->ob), cf::player::list;
		63	utf8::decode $msg;
		64
		65	# npcs, magic_ears etc.
		66	# first find all objects and their inventories within a 5x5 square
		67	# that have something resembling dialogue
		68	my ($map, $x, $y) = ($who->map, $who->x - 2, $who->y - 2);
		69
		70	for my $npc (
		71	grep NPC_Dialogue::has_dialogue $_,
		72	map +($_, $_->inv),
		73	grep $_,
		74	map $map->at ($x + $_ % 5, $y + (int $_ / 5)),
		75	0..24
		76	) {
		77	# if some listener teleported us somewhere else, stop right here
		78	last unless $map->path == $who->map->path;
		79
		80	my $dialog = new NPC_Dialogue ob => $who, npc => $npc;
		81	my ($reply, @kw) = $dialog->tell ($msg);
		82
		83	if (defined $reply) {
		84	if ($npc->type == cf::MAGIC_EAR) {
		85	if (length $reply) {
		86	$_->ob->message ($reply, cf::NDI_BROWN \| cf::NDI_UNIQUE)
		87	for grep $who->on_same_map_as ($_->ob), cf::player::list;
		88	}
		89	$npc->use_trigger;
		90	} else {
		91	if (length $reply) {
		92	$_->ob->message ($npc->name . " says: $reply", cf::NDI_BROWN \| cf::NDI_UNIQUE)
		93	for grep $who->on_same_map_as ($_->ob), cf::player::list;
		94	}
		95	}
		96	}
		97
		98	if (@kw) {
		99	$_->ob->message ("[further topics: " . (join ", ", @kw) . "]", cf::NDI_BROWN \| cf::NDI_UNIQUE)
		100	for grep $who->on_same_map_as ($_->ob), cf::player::list;
		101	}
		102	}
		103
		104	} else {
		105	$who->message ("What do you want to say?", cf::NDI_UNIQUE);
		106	}
		107	};
32		108
33	cf::register_command chat => 0, sub {	109	cf::register_command chat => 0, sub {
34	my ($who, $msg) = @_;	110	my ($who, $msg) = @_;
		111
		112	utf8::decode $msg;
35		113
36	if ($msg) {	114	if ($msg) {
37	my $name = $who->name;	115	my $name = $who->name;
38	my $NOW = time;	116	my $NOW = time;
39		117
		118	utf8::encode $msg; # ->message not yet utf8-ified
		119	# cf::LOG cf::llevDebug, sprintf "QBERT [%s] %s\n", $name, $msg;
		120	cf::ext::schmorp_irc::do_notice (sprintf "[%s] %s", $name, $msg);
		121
40	$_->ob->message ("$name chats: $msg", cf::NDI_BLUE)	122	$_->ob->message ("$name chats: $msg", cf::NDI_BLUE)
41	for grep $_->ob->{ext_ignore_shout}{$name} < $NOW, cf::player::list;	123	for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW && $_->listening >= 10 } cf::player::list;
42		124
43	} else {	125	} else {
44	$who->message ("Chat what?", cf::NDI_UNIQUE);	126	$who->message ("Chat what?", cf::NDI_UNIQUE);
45	}	127	}
46	};	128	};
47		129
48	cf::register_command shout => 0, sub {	130	cf::register_command shout => 0, sub {
49	my ($who, $msg) = @_;	131	my ($who, $msg) = @_;
		132
		133	utf8::decode $msg;
50		134
51	if ($msg) {	135	if ($msg) {
52	my $NOW = time;	136	my $NOW = time;
53	my $name = $who->name;	137	my $name = $who->name;
54		138
		139	# cf::LOG cf::llevDebug, sprintf "QBERT {%s} %s\n", $name, $msg;
		140	cf::ext::schmorp_irc::do_notice (sprintf "{%s} %s\n", $name, $msg);
		141
		142	utf8::encode $msg; # ->message not yet utf8-ified
55	$_->ob->message ("$name shouts: $msg", cf::NDI_RED)	143	$_->ob->message ("$name shouts: $msg", cf::NDI_RED)
56	for grep $_->ob->{ext_ignore_shout}{$name} < $NOW, cf::player::list;	144	for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW && $_->listening >= 2 } cf::player::list;
57		145
58	} else {	146	} else {
59	$who->message ("Shout what?", cf::NDI_UNIQUE);	147	$who->message ("Shout what?", cf::NDI_UNIQUE);
60	}	148	}
61		149
62	};	150	};
63		151
64	cf::register_command tell => 0, sub {	152	cf::register_command tell => 0, sub {
65	my ($who, $args) = @_;	153	my ($who, $args) = @_;
66	my ($target, $msg) = split /\s+/, $args, 2;	154	my ($target, $msg) = split /\s+/, $args, 2;
		155
		156	utf8::decode $msg;
67		157
68	my $name = $who->name;	158	my $name = $who->name;
69		159
70	if (my $other = cf::player::find $target) {	160	if (my $other = cf::player::find $target) {
71		161
73	if ($target eq $name) {	163	if ($target eq $name) {
74	$who->message ("You are talking to yourself, you freak!", cf::NDI_UNIQUE);	164	$who->message ("You are talking to yourself, you freak!", cf::NDI_UNIQUE);
75	} elsif ($other->ob->{ext_ignore_tell}{$name} >= time) {	165	} elsif ($other->ob->{ext_ignore_tell}{$name} >= time) {
76	$who->message ("$target ignores what you say. Give up on it.", cf::NDI_UNIQUE);	166	$who->message ("$target ignores what you say. Give up on it.", cf::NDI_UNIQUE);
77	} else {	167	} else {
		168	utf8::encode $msg; # ->message not yet utf8-ified
		169	cf::LOG cf::llevDebug, sprintf "TELL [%s>%s] %s\n", $name, $target, $msg;
		170
78	$who->message ("You tell $target: $msg");	171	$who->message ("You tell $target: $msg");
79	$other->ob->message ("$name tells you: $msg");	172	$other->ob->message ("$name tells you: $msg");
80	$other->ob->{ext_last_tell} = $name;	173	$other->ob->{ext_last_tell} = $name;
81	}	174	}
82	} else {	175	} else {
…		…
90		183
91	cf::register_command reply => 0, sub {	184	cf::register_command reply => 0, sub {
92	my ($who, $args) = @_;	185	my ($who, $args) = @_;
93	my $name = $who->name;	186	my $name = $who->name;
94		187
		188	utf8::decode $args;
		189
95	if (my $other = cf::player::find $who->{ext_last_tell}) {	190	if (my $other = cf::player::find $who->{ext_last_tell}) {
96	if ($args) {	191	if ($args) {
97		192
98	$other->ob->{ext_ignore_tell}{$name} >= time	193	$other->ob->{ext_ignore_tell}{$name} >= time
99	or delete $other->ob->{ext_ignore_tell}{$name};	194	or delete $other->ob->{ext_ignore_tell}{$name};
100		195
101	if ($other->ob->{ext_ignore_tell}{$name} < time) {	196	if ($other->ob->{ext_ignore_tell}{$name} < time) {
		197	utf8::encode $args; # ->message not yet utf8-ified
		198	cf::LOG cf::llevDebug, sprintf "TELL [%s>%s] %s\n", $name, $other->ob->name, $args;
		199
102	$who->message ("You tell " . $other->ob->name . ": $args");	200	$who->message ("You tell " . $other->ob->name . ": $args");
103	$other->ob->message ("$name tells you: $args");	201	$other->ob->message ("$name tells you: $args");
104	$who->{ext_last_tell} = $other->ob->name;	202	$who->{ext_last_tell} = $other->ob->name;
105	} else {	203	} else {
106	$who->message ($other->ob->name . " ignores what you say. Give up on it.", cf::NDI_UNIQUE);	204	$who->message ($other->ob->name . " ignores what you say. Give up on it.", cf::NDI_UNIQUE);
…		…
135	} elsif ($target && $type) {	233	} elsif ($target && $type) {
136		234
137	$timeout ne "" or $timeout = 24;	235	$timeout ne "" or $timeout = 24;
138	my $absolute_timeout = time + $timeout * 3600;	236	my $absolute_timeout = time + $timeout * 3600;
139		237
140	if (valid_user $target) {	238	if (cf::player::exists $target) {
141	if ($type eq "tell") {	239	if ($type eq "tell") {
142	$who->message ("Now ignoring private messages from $target for $timeout hours.", cf::NDI_UNIQUE);	240	$who->message ("Now ignoring private messages from $target for $timeout hours.", cf::NDI_UNIQUE);
143	$who->{ext_ignore_tell}{$target} = $absolute_timeout;	241	$who->{ext_ignore_tell}{$target} = $absolute_timeout;
144	} elsif ($type eq "shout") {	242	} elsif ($type eq "shout") {
145	$who->message ("Now ignoring shouts from $target for $timeout hours.", cf::NDI_UNIQUE);	243	$who->message ("Now ignoring shouts from $target for $timeout hours.", cf::NDI_UNIQUE);
…		…
154	} else {	252	} else {
155	$who->message ("No such player: $target", cf::NDI_UNIQUE);	253	$who->message ("No such player: $target", cf::NDI_UNIQUE);
156	}	254	}
157		255
158	} else {	256	} else {
159	$who->message ("Usage: ignore <player> <tell \| shout \| all> <timeout>\n"	257	$who->message ("Usage: ignore <player> <tell\|shout\|all> <timeout>\n"
160	. "will ignore a player for <timeout> hours.\n"	258	. "will ignore a player for <timeout> hours.\n"
161	. "Usage: ignore list\n"	259	. "Usage: ignore list\n"
162	. "will show you a list of players currently ignored.", cf::NDI_UNIQUE);	260	. "will show you a list of players currently ignored.", cf::NDI_UNIQUE);
163	}	261	}
164	};	262	};
…		…
175	$who->message ((join ", ", sort keys %{ $who->{ext_ignore_shout} }), cf::NDI_UNIQUE);	273	$who->message ((join ", ", sort keys %{ $who->{ext_ignore_shout} }), cf::NDI_UNIQUE);
176	} else {	274	} else {
177	$who->message ("Not ignoring anyone", cf::NDI_UNIQUE);	275	$who->message ("Not ignoring anyone", cf::NDI_UNIQUE);
178	}	276	}
179	} else {	277	} else {
180		278	if (cf::player::exists $target) {
181	if (valid_user $target) {
182	if ($type eq "tell") {	279	if ($type eq "tell") {
183	$who->message ("Not ignoring private messages from $target anymore.", cf::NDI_UNIQUE);	280	$who->message ("Not ignoring private messages from $target anymore.", cf::NDI_UNIQUE);
184	delete $who->{ext_ignore_tell} {$target};	281	delete $who->{ext_ignore_tell} {$target};
185	} elsif ($type eq "shout") {	282	} elsif ($type eq "shout") {
186	$who->message ("Not ignoring shouts from $target anymore.", cf::NDI_UNIQUE);	283	$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);	290	$who->message ("You need to specify tell, shout or all.", cf::NDI_UNIQUE);
194	}	291	}
195	} else {	292	} else {
196	$who->message ("No such player or ambiguous name: $target", cf::NDI_UNIQUE);	293	$who->message ("No such player or ambiguous name: $target", cf::NDI_UNIQUE);
197	}	294	}
198
199	}	295	}
200	};	296	};
201		297
		298	cf::register_command seen => 0, sub {
		299	my ($who, $args) = @_;
		300
		301	if (my ($login) = $args =~ /(\S+)/) {
		302	if ($login eq $who->name) {
		303	$who->message ("Very funny, $login. Ha. Ha.", cf::NDI_UNIQUE);
		304	} elsif (cf::player::find $login) {
		305	$who->message ("$login is right here on this server!", cf::NDI_UNIQUE);
		306	} elsif (cf::player::exists $login
		307	and stat sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($login) x 2) {
		308	my $time = (stat _)[9];
		309
		310	$who->message ("$login was last seen here "
		311	. (POSIX::strftime "%Y-%m-%d %H:%M:%S +0000", gmtime $time)
		312	. " which was " . (int +(time - $time) / 3600) . " hours ago.", cf::NDI_UNIQUE);
		313	} else {
		314	$who->message ("No player named $login is known to me.", cf::NDI_UNIQUE);
		315	}
		316	} else {
		317	$who->message ("Usage: seen <player>", cf::NDI_UNIQUE);
		318	}
		319	};
		320

Diff Legend

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

Comparing deliantra/maps/perl/chat.ext (file contents): Revision 1.12 by root, Sun May 7 11:23:43 2006 UTC vs. Revision 1.32 by root, Fri Aug 25 13:33:57 2006 UTC

Diff Legend

Comparing deliantra/maps/perl/chat.ext (file contents):
Revision 1.12 by root, Sun May 7 11:23:43 2006 UTC vs.
Revision 1.32 by root, Fri Aug 25 13:33:57 2006 UTC