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.21 by root, Fri Mar 19 22:16:27 2010 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];
83=over 4 81=over 4
84 82
85=item $who - The cf::object::player object that initiated the dialogue. 83=item $who - The cf::object::player object that initiated the dialogue.
86 84
87=item $npc - The NPC (or magic_ear etc.) object that is being talked to. 85=item $npc - The NPC (or magic_ear etc.) object that is being talked to.
86
87=item $map - The map the NPC (not the player) is on.
88 88
89=item $msg - The actual message as passed to this method. 89=item $msg - The actual message as passed to this method.
90 90
91=item $match - An arrayref with previous results from C<@parse>. 91=item $match - An arrayref with previous results from C<@parse>.
92 92
98 98
99=item $flag - A hashref that stores flags associated with the player and 99=item $flag - A hashref that stores flags associated with the player and
100can be seen by all NPCs (so better name your flags uniquely). This is 100can be seen by all NPCs (so better name your flags uniquely). This is
101useful for storing e.g. quest information. See C<@setflag> and C<@ifflag>. 101useful for storing e.g. quest information. See C<@setflag> and C<@ifflag>.
102 102
103=item $find - see @find, below.
104
103=back 105=back
104 106
105The environment is that standard "map scripting environment", which is 107The environment is that standard "map scripting environment", which is
106limited in the type of constructs allowed (no loops, for example). 108limited in the type of constructs allowed (no loops, for example).
107 109
110Here is a example:
111
112=over 4
113
114=item B<matching for an item name>
115
116 @match hi
117 @cond grep $_->name =~ /royalty/, $who->inv
118 You got royalties there! Wanna have!
119
120You may want to change the C<name> method there to something like C<title>,
121C<slaying> or any other method that is allowed to be called on a
122C<cf::object> here.
123
124=item B<matching for an item name and removing the matched item>
125
126 @match found earhorn
127 @cond grep $_->slaying =~ /Gramp's walking stick/, $who->inv
128 @eval my @g = grep { $_->slaying =~ /Gramp's walking stick/ } $who->inv; $g[0]->decrease;
129 Thanks for the earhorn!
130
131This example is a bit more complex. The C<@eval> statement will search
132the players inventory for the same term as the C<@cond> and then
133decreases the number of objects used there.
134
135(See also the map: C<scorn/houses/cornerbrook.map> for an example how this is
136used in the real world :-)
137
138=back
139
108=item @eval perl 140=item @eval perl
109 141
110Like C<@cond>, but proceed regardless of the outcome. 142Like C<@cond>, but proceed regardless of the outcome.
111 143
112=item @msg perl 144=item @msg perl
113 145
114Like C<@cond>, but the return value will be stringified and prepended to 146Like C<@cond>, but the return value will be stringified and prepended to
115the message. 147the reply message.
148
149=item @check match expression
150
151Executes a match expression (see
152http://pod.tst.eu/http://cvs.schmorp.de/deliantra/server/lib/cf/match.pm)
153to see if it matches.
154
155C<self> is the npc object, C<object>, C<source> and C<originator> are the
156player communicating with the NPC.
157
158If the check fails, the match is skipped.
159
160=item @find match expression
161
162Like C<@check> in that it executes a match expression, but instead of
163failing, it gathers all objects into an array and provides a reference to
164the array in the C<$find> variable.
165
166When you want to skip the match when no objects have been found, combine
167C<@find> with C<@cond>:
168
169 @match see my spellbook
170 @find type=SPELLBOOK in inv
171 @cond @$find
172 It looks dirty.
173 @match see my spellbook
174 I can't see any, where do you have it?
116 175
117=item @setstate state value 176=item @setstate state value
118 177
119Sets the named state C<state> to the given C<value>. State values are 178Sets the named state C<state> to the given C<value>. State values are
120associated with a specific player-NPC pair, so each NPC has its own state 179associated with a specific player-NPC pair, so each NPC has its own state
125See C<@ifstate> for an example. 184See C<@ifstate> for an example.
126 185
127=item @ifstate state value 186=item @ifstate state value
128 187
129Requires that the named C<state> has the given C<value>, otherwise this 188Requires that the named C<state> has the given C<value>, otherwise this
130topic is skipped. For more complex comparisons, see C<@cond> with 189topic is skipped. For more complex comparisons, see C<@cond> with
131C<$state>. Example: 190C<$state>. Example:
132 191
133 @match quest 192 @match quest
134 @setstate question quest 193 @setstate question quest
135 Do you really want to help find the magic amulet of Beeblebrox? 194 Do you really want to help find the magic amulet of Beeblebrox?
143associated with a specific player and can be seen by all NPCs. with 202associated with a specific player and can be seen by all NPCs. with
144respect to a particular player, which makes them suitable to store quest 203respect to a particular player, which makes them suitable to store quest
145markers and other information (e.g. reputation/alignment). Flags are 204markers and other information (e.g. reputation/alignment). Flags are
146persistent over the lifetime of a player, so be careful :) 205persistent over the lifetime of a player, so be careful :)
147 206
207Perversely enough, using C<@setfflag> without a C<value> clears the flag
208as if it was never set, so always provide a flag value (e.g. C<1>) when
209you want to set the flag.
210
148See C<@ifflag> for an example. 211See C<@ifflag> for an example.
149 212
150=item @ifflag flag value 213=item @ifflag flag value
151 214
152Requires that the named C<flag> has the given C<value>, otherwise this 215Requires that the named C<flag> has the given C<value>, otherwise this
153topic is skipped. For more complex comparisons, see C<@cond> with 216topic is skipped. For more complex comparisons, see C<@cond> with
154C<$flag>. Example: 217C<$flag>.
218
219If no C<value> is given, then the ifflag succeeds when the flag is true.
220
221Example:
155 222
156 @match I want to do the quest! 223 @match I want to do the quest!
157 @setflag kings_quest 1 224 @setflag kings_quest 1
158 Then seek out Bumblebee in Navar, he will tell you... 225 Then seek out Bumblebee in Navar, he will tell you...
159 @match I did the quest 226 @match I did the quest
173When the state argument is omitted the trigger is stateful and retains an 240When 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 241internal 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 242state won't be changed when the connection is triggered by other triggers. So
176be careful when triggering the connection from other objects. 243be careful when triggering the connection from other objects.
177 244
178When a state argument is given it should be either 0 or 1. 1 will 'push' the connection 245When 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 246C<!= 0> will 'push' the connection (in general, you should specify C<1>
180let a npc control a door. 247for this) and C<0> will 'release' the connection. This is useful for
248example when you want to let an NPC control a door.
181 249
182Trigger all objects with the given connected-id by 'releasing' the connection. 250Trigger all objects with the given connected-id by 'releasing' the connection.
251
252=item @playersound face-name
253
254Plays the given sound face (either an alias or sound file path) so that
255only the player talking to the npc can hear it.
256
257=item @npcsound face-name
258
259Plays the given sound face (either an alias or sound file path) as if
260the npc had made that sound, i.e. it will be located at the npc and all
261players near enough can hear it.
183 262
184=item @addtopic topic 263=item @addtopic topic
185 264
186Adds the given topic names (separated by C<|>) to the list of topics 265Adds the given topic names (separated by C<|>) to the list of topics
187returned. 266returned.
196 my $lcmsg = lc $msg; 275 my $lcmsg = lc $msg;
197 276
198 topic: 277 topic:
199 for my $match (@{ $self->{match} }) { 278 for my $match (@{ $self->{match} }) {
200 for (split /\|/, $match->[0]) { 279 for (split /\|/, $match->[0]) {
201 if ($_ eq "*" || $lcmsg eq lc) { 280 if ($_ eq "*" || $lcmsg =~ /\b\Q$_\E\b/i) {
202 my $reply = $match->[1]; 281 my $reply = $match->[1];
203 my @kw; 282 my @kw;
204 283
205 my @replies; 284 my @replies;
206 my @match; # @match/@parse command results 285 my @match; # @match/@parse command results
207 286
208 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {}; 287 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {};
209 my $flag = $self->{ob}{dialog_flag} ||= {}; 288 my $flag = $self->{ob}{dialog_flag} ||= {};
289
290 my @find;
210 291
211 my %vars = ( 292 my %vars = (
212 who => $self->{ob}, 293 who => $self->{ob},
213 npc => $self->{npc}, 294 npc => $self->{npc},
295 map => $self->{npc}->map,
214 state => $state, 296 state => $state,
215 flag => $flag, 297 flag => $flag,
216 msg => $msg, 298 msg => $msg,
217 match => \@match, 299 match => \@match,
300 find => \@find,
218 ); 301 );
219 302
220 local $self->{ob}{record_replies} = \@replies; 303 local $self->{ob}{record_replies} = \@replies;
221 304
222 # now execute @-commands (which can result in a no-match) 305 # now execute @-commands (which can result in a no-match)
229 or next topic; 312 or next topic;
230 313
231 } elsif ($cmd eq "comment") { 314 } elsif ($cmd eq "comment") {
232 # nop 315 # nop
233 316
317 } elsif ($cmd eq "playersound") {
318 $self->{ob}->contr->play_sound (cf::sound::find $args);
319
320 } elsif ($cmd eq "npcsound") {
321 $self->{npc}->play_sound (cf::sound::find $args);
322
234 } elsif ($cmd eq "cond") { 323 } elsif ($cmd eq "cond") {
235 cf::safe_eval $args, %vars 324 cf::safe_eval $args, %vars
236 or next topic; 325 or next topic;
237 326
238 } elsif ($cmd eq "eval") { 327 } elsif ($cmd eq "eval") {
239 cf::safe_eval $args, %vars; 328 cf::safe_eval $args, %vars;
240 warn "\@eval evaluation error: $@\n" if $@; 329 warn "\@eval evaluation error: $@\n" if $@;
241 330
331 } elsif ($cmd eq "check") {
332 eval {
333 cf::match::match $args, $self->{ob}, $self->{npc}, $self->{ob}
334 or next topic;
335 };
336 warn "\@check evaluation error: $@\n" if $@;
337
338 } elsif ($cmd eq "find") {
339 @find = eval {
340 cf::match::match $args, $self->{ob}, $self->{npc}, $self->{ob}
341 };
342 warn "\@find evaluation error: $@\n" if $@;
343
242 } elsif ($cmd eq "msg") { 344 } elsif ($cmd eq "msg") {
243 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)]; 345 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)];
244 346
245 } elsif ($cmd eq "setflag") { 347 } elsif ($cmd eq "setflag") {
246 my ($name, $value) = split /\s+/, $args, 2; 348 my ($name, $value) = split /\s+/, $args, 2;
247 $value ? $flag->{$name} = $value 349 defined $value ? $flag->{$name} = $value
248 : delete $flag->{$name}; 350 : delete $flag->{$name};
249 351
250 } elsif ($cmd eq "setstate") { 352 } elsif ($cmd eq "setstate") {
251 my ($name, $value) = split /\s+/, $args, 2; 353 my ($name, $value) = split /\s+/, $args, 2;
252 $value ? $state->{$name} = $value 354 defined $value ? $state->{$name} = $value
253 : delete $state->{$name}; 355 : delete $state->{$name};
254 356
255 } elsif ($cmd eq "ifflag") { 357 } elsif ($cmd eq "ifflag") {
256 my ($name, $value) = split /\s+/, $args, 2; 358 my ($name, $value) = split /\s+/, $args, 2;
257 $flag->{$name} eq $value 359 defined $value ? $flag->{$name} eq $value
360 : $flag->{$name}
258 or next topic; 361 or next topic;
259 362
260 } elsif ($cmd eq "ifstate") { 363 } elsif ($cmd eq "ifstate") {
261 my ($name, $value) = split /\s+/, $args, 2; 364 my ($name, $value) = split /\s+/, $args, 2;
262 $state->{$name} eq $value 365 defined $value ? $state->{$name} eq $value
366 : $state->{$name}
263 or next topic; 367 or next topic;
264 368
265 } elsif ($cmd eq "trigger") { 369 } elsif ($cmd eq "trigger") {
266 my ($con, $state) = split /\s+/, $args, 2; 370 my ($con, $state) = split /\s+/, $args, 2;
267 $con = $con * 1;
268 371
269 if (defined $state) { 372 if (defined $state) {
270 $self->{npc}->map->trigger ($args, $state); 373 $self->{npc}->map->trigger ($con, $state, $self->{npc}, $self->{ob});
271 } else { 374 } else {
272 my $rvalue = \$self->{npc}{dialog_trigger}{$con}; 375 my $rvalue = \$self->{npc}{dialog_trigger}{$con+0};
273 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue); 376 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue, $self->{npc}, $self->{ob});
274 } 377 }
275 378
276 } elsif ($cmd eq "addtopic") { 379 } elsif ($cmd eq "addtopic") {
277 push @kw, split /\|/, $args; 380 push @kw, split /\|/, $args;
278 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic}; 381 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic};
286 } 389 }
287 } 390 }
288 391
289 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state; 392 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state;
290 delete $self->{ob}{dialog_flag} unless %$flag; 393 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 394
296 # ignores flags and npc from replies 395 # ignores flags and npc from replies
297 $reply = join "\n", (map $_->[1], @replies), $reply; 396 $reply = join "\n", (map $_->[1], @replies), $reply;
298 397
299 # now mark up all matching keywords 398 # now mark up all matching keywords
304 last; 403 last;
305 } 404 }
306 } 405 }
307 } 406 }
308 407
408 $self->{npc}->use_trigger ($self->{ob})
409 if $self->{npc}->type == cf::MAGIC_EAR;
410
309 return wantarray ? ($reply, @kw) : $reply; 411 return wantarray ? ($reply, @kw) : $reply;
310 } 412 }
311 } 413 }
312 } 414 }
313 415

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines