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.8 by root, Sun Aug 26 04:07:40 2007 UTC vs.
Revision 1.18 by root, Wed Nov 4 19:20:49 2009 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.
217 249
218=item @playersound face-name 250=item @playersound face-name
219 251
250 my @replies; 282 my @replies;
251 my @match; # @match/@parse command results 283 my @match; # @match/@parse command results
252 284
253 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {}; 285 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {};
254 my $flag = $self->{ob}{dialog_flag} ||= {}; 286 my $flag = $self->{ob}{dialog_flag} ||= {};
287
288 my @find;
255 289
256 my %vars = ( 290 my %vars = (
257 who => $self->{ob}, 291 who => $self->{ob},
258 npc => $self->{npc}, 292 npc => $self->{npc},
259 state => $state, 293 state => $state,
260 flag => $flag, 294 flag => $flag,
261 msg => $msg, 295 msg => $msg,
262 match => \@match, 296 match => \@match,
297 find => \@find,
263 ); 298 );
264 299
265 local $self->{ob}{record_replies} = \@replies; 300 local $self->{ob}{record_replies} = \@replies;
266 301
267 # now execute @-commands (which can result in a no-match) 302 # now execute @-commands (which can result in a no-match)
288 323
289 } elsif ($cmd eq "eval") { 324 } elsif ($cmd eq "eval") {
290 cf::safe_eval $args, %vars; 325 cf::safe_eval $args, %vars;
291 warn "\@eval evaluation error: $@\n" if $@; 326 warn "\@eval evaluation error: $@\n" if $@;
292 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
293 } elsif ($cmd eq "msg") { 341 } elsif ($cmd eq "msg") {
294 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)]; 342 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)];
295 343
296 } elsif ($cmd eq "setflag") { 344 } elsif ($cmd eq "setflag") {
297 my ($name, $value) = split /\s+/, $args, 2; 345 my ($name, $value) = split /\s+/, $args, 2;
303 $value ? $state->{$name} = $value 351 $value ? $state->{$name} = $value
304 : delete $state->{$name}; 352 : delete $state->{$name};
305 353
306 } elsif ($cmd eq "ifflag") { 354 } elsif ($cmd eq "ifflag") {
307 my ($name, $value) = split /\s+/, $args, 2; 355 my ($name, $value) = split /\s+/, $args, 2;
308 $flag->{$name} eq $value 356 defined $value ? $flag->{$name} eq $value
357 : $flag->{$name}
309 or next topic; 358 or next topic;
310 359
311 } elsif ($cmd eq "ifstate") { 360 } elsif ($cmd eq "ifstate") {
312 my ($name, $value) = split /\s+/, $args, 2; 361 my ($name, $value) = split /\s+/, $args, 2;
313 $state->{$name} eq $value 362 $state->{$name} eq $value
314 or next topic; 363 or next topic;
315 364
316 } elsif ($cmd eq "trigger") { 365 } elsif ($cmd eq "trigger") {
317 my ($con, $state) = split /\s+/, $args, 2; 366 my ($con, $state) = split /\s+/, $args, 2;
318 $con = $con * 1;
319 367
320 if (defined $state) { 368 if (defined $state) {
321 $self->{npc}->map->trigger ($args, $state); 369 $self->{npc}->map->trigger ($con, $state, $self->{npc}, $self->{ob});
322 } else { 370 } else {
323 my $rvalue = \$self->{npc}{dialog_trigger}{$con}; 371 my $rvalue = \$self->{npc}{dialog_trigger}{$con+0};
324 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue); 372 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue, $self->{npc}, $self->{ob});
325 } 373 }
326 374
327 } elsif ($cmd eq "addtopic") { 375 } elsif ($cmd eq "addtopic") {
328 push @kw, split /\|/, $args; 376 push @kw, split /\|/, $args;
329 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic}; 377 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic};
337 } 385 }
338 } 386 }
339 387
340 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state; 388 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state;
341 delete $self->{ob}{dialog_flag} unless %$flag; 389 delete $self->{ob}{dialog_flag} unless %$flag;
342
343 # combine lines into paragraphs
344 $reply =~ s/(?<=\S)\n(?=\w)/ /g;
345 $reply =~ s/\n\n/\n/g;
346 390
347 # ignores flags and npc from replies 391 # ignores flags and npc from replies
348 $reply = join "\n", (map $_->[1], @replies), $reply; 392 $reply = join "\n", (map $_->[1], @replies), $reply;
349 393
350 # now mark up all matching keywords 394 # now mark up all matching keywords
355 last; 399 last;
356 } 400 }
357 } 401 }
358 } 402 }
359 403
404 $self->{npc}->use_trigger ($self->{ob})
405 if $self->{npc}->type == cf::MAGIC_EAR;
406
360 return wantarray ? ($reply, @kw) : $reply; 407 return wantarray ? ($reply, @kw) : $reply;
361 } 408 }
362 } 409 }
363 } 410 }
364 411

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines