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

Comparing deliantra/maps/perl/chat.ext (file contents):
Revision 1.14 by pippijn, Sun May 7 20:23:32 2006 UTC vs.
Revision 1.33 by root, Fri Aug 25 15:07:43 2006 UTC

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

Diff Legend

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

Comparing deliantra/maps/perl/chat.ext (file contents): Revision 1.14 by pippijn, Sun May 7 20:23:32 2006 UTC vs. Revision 1.33 by root, Fri Aug 25 15:07:43 2006 UTC

Diff Legend

Comparing deliantra/maps/perl/chat.ext (file contents):
Revision 1.14 by pippijn, Sun May 7 20:23:32 2006 UTC vs.
Revision 1.33 by root, Fri Aug 25 15:07:43 2006 UTC