ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/NPC_Dialogue.pm
(Generate patch)

Comparing deliantra/server/ext/NPC_Dialogue.pm (file contents):
Revision 1.2 by elmex, Thu Jan 4 15:20:11 2007 UTC vs.
Revision 1.14 by root, Thu Jan 8 19:23:44 2009 UTC

… …
4 4
5=head1 DESCRIPTION 5=head1 DESCRIPTION
6 6
7NPC dialogue support module. 7NPC dialogue support module.
8 8
9=over 4
10
9=cut 11=cut
10 12
11package NPC_Dialogue; 13package NPC_Dialogue;
12 14
13use strict; 15use strict;
14
15sub has_dialogue($) {
16 my ($ob) = @_;
17
18 $ob->msg =~ /^\@match /;
19}
20 16
21sub parse_message($) { 17sub parse_message($) {
22 map [split /\n/, $_, 2], 18 map [split /\n/, $_, 2],
23 grep length, 19 grep length,
24 split /^\@match /m, 20 split /^\@match /m,
… …
26} 22}
27 23
28sub new { 24sub new {
29 my ($class, %arg) = @_; 25 my ($class, %arg) = @_;
30 26
27 $arg{ob} = $arg{pl}->ob;
28
31 my $self = bless { 29 my $self = bless {
32 %arg, 30 %arg,
33 }, $class; 31 }, $class;
34 32
35 $self->{match} ||= [parse_message $self->{npc}->msg]; 33 $self->{match} ||= [parse_message $self->{npc}->msg];
… …
102 100
103=back 101=back
104 102
105The environment is that standard "map scripting environment", which is 103The environment is that standard "map scripting environment", which is
106limited in the type of constructs allowed (no loops, for example). 104limited in the type of constructs allowed (no loops, for example).
105
106Here is a example:
107
108=over 4
109
110=item B<matching for an item name>
111
112 @match hi
113 @cond grep $_->name =~ /royalty/, $who->inv
114 You got royalties there! Wanna have!
115
116You may want to change the C<name> method there to something like C<title>,
117C<slaying> or any other method that is allowed to be called on a
118C<cf::object> here.
119
120=item B<matching for an item name and removing the matched item>
121
122 @match found earhorn
123 @cond grep $_->slaying =~ /Gramp's walking stick/, $who->inv
124 @eval my @g = grep { $_->slaying =~ /Gramp's walking stick/ } $who->inv; $g[0]->decrease;
125 Thanks for the earhorn!
126
127This example is a bit more complex. The C<@eval> statement will search
128the players inventory for the same term as the C<@cond> and then
129decreases the number of objects used there.
130
131(See also the map: C<scorn/houses/cornerbrook.map> for an example how this is
132used in the real world :-)
133
134=back
107 135
108=item @eval perl 136=item @eval perl
109 137
110Like C<@cond>, but proceed regardless of the outcome. 138Like C<@cond>, but proceed regardless of the outcome.
111 139
… …
173When the state argument is omitted the trigger is stateful and retains an 201When the state argument is omitted the trigger is stateful and retains an
174internal state per connected-id. There is a limitation to the use of this: The 202internal state per connected-id. There is a limitation to the use of this: The
175state won't be changed when the connection is triggered by other triggers. So 203state won't be changed when the connection is triggered by other triggers. So
176be careful when triggering the connection from other objects. 204be careful when triggering the connection from other objects.
177 205
178When a state argument is given it should be either 0 or 1. 1 will 'push' the connection 206When a state argument is given it should be a positive integer. Any value
179and 0 will 'release' the connection. This is useful for example when you want to 207C<!= 0> will 'push' the connection (in general, you should specify C<1>
180let a npc control a door. 208for this) and C<0> will 'release' the connection. This is useful for
209example when you want to let an NPC control a door.
181 210
182Trigger all objects with the given connected-id by 'releasing' the connection. 211Trigger all objects with the given connected-id by 'releasing' the connection.
212
213=item @playersound face-name
214
215Plays the given sound face (either an alias or sound file path) so that
216only the player talking to the npc can hear it.
217
218=item @npcsound face-name
219
220Plays the given sound face (either an alias or sound file path) as if
221the npc had made that sound, i.e. it will be located at the npc and all
222players near enough can hear it.
183 223
184=item @addtopic topic 224=item @addtopic topic
185 225
186Adds the given topic names (separated by C<|>) to the list of topics 226Adds the given topic names (separated by C<|>) to the list of topics
187returned. 227returned.
… …
196 my $lcmsg = lc $msg; 236 my $lcmsg = lc $msg;
197 237
198 topic: 238 topic:
199 for my $match (@{ $self->{match} }) { 239 for my $match (@{ $self->{match} }) {
200 for (split /\|/, $match->[0]) { 240 for (split /\|/, $match->[0]) {
201 if ($_ eq "*" || $lcmsg eq lc) { 241 if ($_ eq "*" || $lcmsg =~ /\b\Q$_\E\b/i) {
202 my $reply = $match->[1]; 242 my $reply = $match->[1];
203 my @kw; 243 my @kw;
204 244
205 my @replies; 245 my @replies;
206 my @match; # @match/@parse command results 246 my @match; # @match/@parse command results
… …
229 or next topic; 269 or next topic;
230 270
231 } elsif ($cmd eq "comment") { 271 } elsif ($cmd eq "comment") {
232 # nop 272 # nop
233 273
274 } elsif ($cmd eq "playersound") {
275 $self->{ob}->contr->play_sound (cf::sound::find $args);
276
277 } elsif ($cmd eq "npcsound") {
278 $self->{npc}->play_sound (cf::sound::find $args);
279
234 } elsif ($cmd eq "cond") { 280 } elsif ($cmd eq "cond") {
235 cf::safe_eval $args, %vars 281 cf::safe_eval $args, %vars
236 or next topic; 282 or next topic;
237 283
238 } elsif ($cmd eq "eval") { 284 } elsif ($cmd eq "eval") {
… …
262 $state->{$name} eq $value 308 $state->{$name} eq $value
263 or next topic; 309 or next topic;
264 310
265 } elsif ($cmd eq "trigger") { 311 } elsif ($cmd eq "trigger") {
266 my ($con, $state) = split /\s+/, $args, 2; 312 my ($con, $state) = split /\s+/, $args, 2;
267 $con = $con * 1;
268 313
269 if (defined $state) { 314 if (defined $state) {
270 $self->{npc}->map->trigger ($args, $state); 315 $self->{npc}->map->trigger ($con, $state, $self->{npc}, $self->{ob});
271 } else { 316 } else {
272 my $rvalue = \$self->{npc}{dialog_trigger}{$con}; 317 my $rvalue = \$self->{npc}{dialog_trigger}{$con+0};
273 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue); 318 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue, $self->{npc}, $self->{ob});
274 } 319 }
275 320
276 } elsif ($cmd eq "addtopic") { 321 } elsif ($cmd eq "addtopic") {
277 push @kw, split /\|/, $args; 322 push @kw, split /\|/, $args;
278 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic}; 323 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic};
… …
286 } 331 }
287 } 332 }
288 333
289 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state; 334 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state;
290 delete $self->{ob}{dialog_flag} unless %$flag; 335 delete $self->{ob}{dialog_flag} unless %$flag;
291
292 # combine lines into paragraphs
293 $reply =~ s/(?<=\S)\n(?=\w)/ /g;
294 $reply =~ s/\n\n/\n/g;
295 336
296 # ignores flags and npc from replies 337 # ignores flags and npc from replies
297 $reply = join "\n", (map $_->[1], @replies), $reply; 338 $reply = join "\n", (map $_->[1], @replies), $reply;
298 339
299 # now mark up all matching keywords 340 # now mark up all matching keywords
… …
304 last; 345 last;
305 } 346 }
306 } 347 }
307 } 348 }
308 349
350 $self->{npc}->use_trigger ($self->{ob})
351 if $self->{npc}->type == cf::MAGIC_EAR;
352
309 return wantarray ? ($reply, @kw) : $reply; 353 return wantarray ? ($reply, @kw) : $reply;
310 } 354 }
311 } 355 }
312 } 356 }
313 357

Diff Legend

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