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.7 by elmex, Sat Aug 25 16:51:38 2007 UTC vs.
Revision 1.19 by root, Fri Feb 5 01:26:35 2010 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines