ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/chat.ext
Revision: 1.32
Committed: Fri Aug 25 13:33:57 2006 UTC (17 years, 8 months ago) by root
Branch: MAIN
Changes since 1.31: +8 -5 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 pippijn 1.1 #! perl
2 root 1.5
3 pippijn 1.15 # implement a replacement for the built-in say/chat/shout/tell/reply commands
4 root 1.5 # adds ignore/unignore functionality
5    
6 root 1.20 use NPC_Dialogue;
7 root 1.23 use POSIX (); # for strftime only
8 root 1.20
9 root 1.12 sub clean_timeouts($) {
10 root 1.8 my ($player) = @_;
11     my $NOW = time;
12    
13     for my $hash (@$player{qw(ext_ignore_shout ext_ignore_tell)}) {
14 root 1.12 while (my ($k, $v) = each %$hash) {
15     if ($v < $NOW) {
16 root 1.20 $player->message ("Your ignore on $k has expired.", cf::NDI_GREEN | cf::NDI_UNIQUE);
17 root 1.12 delete $hash->{$k};
18 root 1.22 } elsif (!cf::player::exists $k) {
19 root 1.20 $player->message ("Your ignore on $k is no longer valid (no such user).", cf::NDI_GREEN | cf::NDI_UNIQUE);
20 root 1.12 delete $hash->{$k};
21     }
22     }
23 root 1.8 }
24     }
25    
26 root 1.32 cf::attach_to_players
27     prio => -1000,
28     on_login => sub {
29     my ($pl) = @_;
30    
31     clean_timeouts $pl->ob;
32     },
33     ;
34 root 1.8
35 pippijn 1.15 cf::register_command listen => 0, sub {
36     my ($who, $msg) = @_;
37     my $player = cf::player::find $who->name;
38    
39 pippijn 1.17 if ($msg ne "") {
40 pippijn 1.15 my $prev_listen = $player->listening;
41     $player->listening ($msg);
42     if ($prev_listen == $player->listening) {
43 root 1.20 $who->message ("Your verbose level stayed $prev_listen.", cf::NDI_UNIQUE);
44 pippijn 1.15 } else {
45 root 1.20 $who->message ("Your verbose level is now " . $player->listening . ". (previously: $prev_listen)", cf::NDI_UNIQUE);
46 pippijn 1.15 }
47     } else {
48 root 1.20 $who->message ("Your verbose level is " . $player->listening . ".", cf::NDI_UNIQUE);
49 pippijn 1.15 }
50     };
51    
52 root 1.21 cf::register_command say => 0, sub {
53 root 1.20 my ($who, $msg) = @_;
54    
55 root 1.27 utf8::decode $msg;
56    
57 root 1.20 if ($msg) {
58     my $name = $who->name;
59    
60 root 1.27 utf8::encode $msg; # ->message not yet utf8-ified
61 root 1.21 $_->ob->message ("$name says: $msg", cf::NDI_GREY | cf::NDI_UNIQUE)
62     for grep $who->on_same_map_as ($_->ob), cf::player::list;
63 root 1.27 utf8::decode $msg;
64 root 1.20
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 root 1.26 my ($reply, @kw) = $dialog->tell ($msg);
82 root 1.20
83     if (defined $reply) {
84     if ($npc->type == cf::MAGIC_EAR) {
85 root 1.21 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 root 1.20 $npc->use_trigger;
90     } else {
91 root 1.21 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 root 1.20 }
96     }
97 root 1.26
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 root 1.20 }
103    
104     } else {
105     $who->message ("What do you want to say?", cf::NDI_UNIQUE);
106     }
107     };
108 pippijn 1.15
109 pippijn 1.6 cf::register_command chat => 0, sub {
110 pippijn 1.1 my ($who, $msg) = @_;
111    
112 root 1.27 utf8::decode $msg;
113    
114 pippijn 1.1 if ($msg) {
115     my $name = $who->name;
116 root 1.8 my $NOW = time;
117 pippijn 1.1
118 root 1.27 utf8::encode $msg; # ->message not yet utf8-ified
119 root 1.30 # cf::LOG cf::llevDebug, sprintf "QBERT [%s] %s\n", $name, $msg;
120 elmex 1.29 cf::ext::schmorp_irc::do_notice (sprintf "[%s] %s", $name, $msg);
121 root 1.19
122 root 1.4 $_->ob->message ("$name chats: $msg", cf::NDI_BLUE)
123 pippijn 1.15 for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW && $_->listening >= 10 } cf::player::list;
124 root 1.4
125 pippijn 1.1 } else {
126     $who->message ("Chat what?", cf::NDI_UNIQUE);
127     }
128     };
129    
130 pippijn 1.6 cf::register_command shout => 0, sub {
131 pippijn 1.1 my ($who, $msg) = @_;
132    
133 root 1.27 utf8::decode $msg;
134    
135 pippijn 1.1 if ($msg) {
136 root 1.8 my $NOW = time;
137 pippijn 1.1 my $name = $who->name;
138    
139 root 1.30 # cf::LOG cf::llevDebug, sprintf "QBERT {%s} %s\n", $name, $msg;
140 elmex 1.29 cf::ext::schmorp_irc::do_notice (sprintf "{%s} %s\n", $name, $msg);
141 root 1.19
142 root 1.27 utf8::encode $msg; # ->message not yet utf8-ified
143 root 1.4 $_->ob->message ("$name shouts: $msg", cf::NDI_RED)
144 pippijn 1.15 for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW && $_->listening >= 2 } cf::player::list;
145 root 1.4
146 pippijn 1.1 } else {
147     $who->message ("Shout what?", cf::NDI_UNIQUE);
148     }
149    
150     };
151 root 1.5
152     cf::register_command tell => 0, sub {
153     my ($who, $args) = @_;
154     my ($target, $msg) = split /\s+/, $args, 2;
155    
156 root 1.27 utf8::decode $msg;
157    
158 root 1.5 my $name = $who->name;
159    
160 pippijn 1.11 if (my $other = cf::player::find $target) {
161 root 1.12
162 pippijn 1.11 if ($msg) {
163 root 1.12 if ($target eq $name) {
164     $who->message ("You are talking to yourself, you freak!", cf::NDI_UNIQUE);
165     } elsif ($other->ob->{ext_ignore_tell}{$name} >= time) {
166     $who->message ("$target ignores what you say. Give up on it.", cf::NDI_UNIQUE);
167     } else {
168 root 1.27 utf8::encode $msg; # ->message not yet utf8-ified
169 root 1.19 cf::LOG cf::llevDebug, sprintf "TELL [%s>%s] %s\n", $name, $target, $msg;
170    
171 pippijn 1.9 $who->message ("You tell $target: $msg");
172     $other->ob->message ("$name tells you: $msg");
173     $other->ob->{ext_last_tell} = $name;
174     }
175 root 1.5 } else {
176 pippijn 1.11 $who->message ("What do you want to tell $target?", cf::NDI_UNIQUE);
177 root 1.5 }
178 root 1.12
179 root 1.5 } else {
180 root 1.12 $who->message ("No such player. Your message: $msg", cf::NDI_UNIQUE);
181 root 1.5 }
182     };
183    
184     cf::register_command reply => 0, sub {
185     my ($who, $args) = @_;
186     my $name = $who->name;
187    
188 root 1.27 utf8::decode $args;
189    
190 pippijn 1.11 if (my $other = cf::player::find $who->{ext_last_tell}) {
191     if ($args) {
192 root 1.5
193 pippijn 1.9 $other->ob->{ext_ignore_tell}{$name} >= time
194     or delete $other->ob->{ext_ignore_tell}{$name};
195    
196     if ($other->ob->{ext_ignore_tell}{$name} < time) {
197 root 1.28 utf8::encode $args; # ->message not yet utf8-ified
198 root 1.19 cf::LOG cf::llevDebug, sprintf "TELL [%s>%s] %s\n", $name, $other->ob->name, $args;
199    
200 pippijn 1.9 $who->message ("You tell " . $other->ob->name . ": $args");
201     $other->ob->message ("$name tells you: $args");
202     $who->{ext_last_tell} = $other->ob->name;
203     } else {
204     $who->message ($other->ob->name . " ignores what you say. Give up on it.", cf::NDI_UNIQUE);
205     }
206 root 1.5 } else {
207 pippijn 1.11 $who->message ("What do you want to tell ".$other->ob->name."?", cf::NDI_UNIQUE);
208 root 1.5 }
209 pippijn 1.11
210 root 1.5 } else {
211 pippijn 1.11 $who->message ("Can't reply, player left. Your message: $args", cf::NDI_UNIQUE);
212 root 1.5 }
213     };
214    
215     cf::register_command ignore => 0, sub {
216     my ($who, $args) = @_;
217     my ($target, $type, $timeout) = split /\s+/, $args;
218    
219     if ($args eq "list") {
220 root 1.8 clean_timeouts $who;
221    
222 root 1.5 if ((my @ignored_tell = sort keys %{$who->{ext_ignore_tell}})
223     + (my @ignored_shout = sort keys %{$who->{ext_ignore_shout}})) {
224     $who->message ("Currently ignoring private messages from: ", cf::NDI_UNIQUE);
225     $who->message ((join ", ", @ignored_tell), cf::NDI_UNIQUE);
226     $who->message ("Currently ignoring shouts from: ", cf::NDI_UNIQUE);
227     $who->message ((join ", ", @ignored_shout), cf::NDI_UNIQUE);
228     $who->message ("To stop ignoring one, use unignore.", cf::NDI_UNIQUE);
229     } else {
230     $who->message ("Not ignoring anyone", cf::NDI_UNIQUE);
231     }
232    
233     } elsif ($target && $type) {
234    
235     $timeout ne "" or $timeout = 24;
236     my $absolute_timeout = time + $timeout * 3600;
237    
238 root 1.22 if (cf::player::exists $target) {
239 root 1.5 if ($type eq "tell") {
240 root 1.12 $who->message ("Now ignoring private messages from $target for $timeout hours.", cf::NDI_UNIQUE);
241     $who->{ext_ignore_tell}{$target} = $absolute_timeout;
242 root 1.5 } elsif ($type eq "shout") {
243 root 1.12 $who->message ("Now ignoring shouts from $target for $timeout hours.", cf::NDI_UNIQUE);
244     $who->{ext_ignore_shout}{$target} = $absolute_timeout;
245 root 1.5 } elsif ($type eq "all") {
246 root 1.12 $who->message ("Now ignoring everything from $target for $timeout hours.", cf::NDI_UNIQUE);
247     $who->{ext_ignore_tell}{$target} = $absolute_timeout;
248     $who->{ext_ignore_shout}{$target} = $absolute_timeout;
249 root 1.5 } else {
250     $who->message ("You need to specify tell, shout or all.", cf::NDI_UNIQUE);
251     }
252     } else {
253 root 1.12 $who->message ("No such player: $target", cf::NDI_UNIQUE);
254 root 1.5 }
255    
256     } else {
257 root 1.23 $who->message ("Usage: ignore <player> <tell|shout|all> <timeout>\n"
258 root 1.12 . "will ignore a player for <timeout> hours.\n"
259     . "Usage: ignore list\n"
260     . "will show you a list of players currently ignored.", cf::NDI_UNIQUE);
261 root 1.5 }
262     };
263    
264     cf::register_command unignore => 0, sub {
265     my ($who, $args) = @_;
266     my ($target, $type) = split /\s+/, $args;
267    
268     if ($args eq "") {
269 root 1.12 if ($who->{ext_ignore_tell}) {
270 root 1.5 $who->message ("Currently ignoring private messages from: ", cf::NDI_UNIQUE);
271     $who->message ((join ", ", sort keys %{ $who->{ext_ignore_tell} }), cf::NDI_UNIQUE);
272     $who->message ("Currently ignoring shouts from: ", cf::NDI_UNIQUE);
273     $who->message ((join ", ", sort keys %{ $who->{ext_ignore_shout} }), cf::NDI_UNIQUE);
274     } else {
275     $who->message ("Not ignoring anyone", cf::NDI_UNIQUE);
276     }
277     } else {
278 root 1.22 if (cf::player::exists $target) {
279 root 1.5 if ($type eq "tell") {
280 root 1.12 $who->message ("Not ignoring private messages from $target anymore.", cf::NDI_UNIQUE);
281     delete $who->{ext_ignore_tell} {$target};
282 root 1.5 } elsif ($type eq "shout") {
283 root 1.12 $who->message ("Not ignoring shouts from $target anymore.", cf::NDI_UNIQUE);
284     delete $who->{ext_ignore_shout}{$target};
285 root 1.5 } elsif ($type eq "all") {
286 root 1.12 $who->message ("Not ignoring anything from $target anymore.", cf::NDI_UNIQUE);
287     delete $who->{ext_ignore_tell} {$target};
288     delete $who->{ext_ignore_shout}{$target};
289 root 1.5 } else {
290     $who->message ("You need to specify tell, shout or all.", cf::NDI_UNIQUE);
291     }
292     } else {
293     $who->message ("No such player or ambiguous name: $target", cf::NDI_UNIQUE);
294     }
295 root 1.23 }
296     };
297    
298     cf::register_command seen => 0, sub {
299     my ($who, $args) = @_;
300 root 1.5
301 root 1.23 if (my ($login) = $args =~ /(\S+)/) {
302 root 1.24 if ($login eq $who->name) {
303     $who->message ("Very funny, $login. Ha. Ha.", cf::NDI_UNIQUE);
304     } elsif (cf::player::find $login) {
305 root 1.23 $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 root 1.25 $who->message ("$login was last seen here "
311 root 1.23 . (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 root 1.5 }
319     };
320