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.4 by root, Sat Jun 16 14:35:41 2007 UTC vs.
Revision 1.18 by root, Wed Nov 4 19:20:49 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,
100 96
101=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
102can 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
103useful 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>.
104 100
101=item $find - see @find, below.
102
105=back 103=back
106 104
107The environment is that standard "map scripting environment", which is 105The environment is that standard "map scripting environment", which is
108limited in the type of constructs allowed (no loops, for example). 106limited in the type of constructs allowed (no loops, for example).
109 107
108Here is a example:
109
110=over 4
111
112=item B<matching for an item name>
113
114 @match hi
115 @cond grep $_->name =~ /royalty/, $who->inv
116 You got royalties there! Wanna have!
117
118You may want to change the C<name> method there to something like C<title>,
119C<slaying> or any other method that is allowed to be called on a
120C<cf::object> here.
121
122=item B<matching for an item name and removing the matched item>
123
124 @match found earhorn
125 @cond grep $_->slaying =~ /Gramp's walking stick/, $who->inv
126 @eval my @g = grep { $_->slaying =~ /Gramp's walking stick/ } $who->inv; $g[0]->decrease;
127 Thanks for the earhorn!
128
129This example is a bit more complex. The C<@eval> statement will search
130the players inventory for the same term as the C<@cond> and then
131decreases the number of objects used there.
132
133(See also the map: C<scorn/houses/cornerbrook.map> for an example how this is
134used in the real world :-)
135
136=back
137
110=item @eval perl 138=item @eval perl
111 139
112Like C<@cond>, but proceed regardless of the outcome. 140Like C<@cond>, but proceed regardless of the outcome.
113 141
114=item @msg perl 142=item @msg perl
115 143
116Like 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
117the 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?
118 173
119=item @setstate state value 174=item @setstate state value
120 175
121Sets 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
122associated 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
145associated 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
146respect to a particular player, which makes them suitable to store quest 201respect to a particular player, which makes them suitable to store quest
147markers and other information (e.g. reputation/alignment). Flags are 202markers and other information (e.g. reputation/alignment). Flags are
148persistent over the lifetime of a player, so be careful :) 203persistent over the lifetime of a player, so be careful :)
149 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
150See C<@ifflag> for an example. 209See C<@ifflag> for an example.
151 210
152=item @ifflag flag value 211=item @ifflag flag value
153 212
154Requires 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
155topic is skipped. For more complex comparisons, see C<@cond> with 214topic is skipped. For more complex comparisons, see C<@cond> with
156C<$flag>. Example: 215C<$flag>.
216
217If no C<value> is given, then the ifflag succeeds when the flag is true.
218
219Example:
157 220
158 @match I want to do the quest! 221 @match I want to do the quest!
159 @setflag kings_quest 1 222 @setflag kings_quest 1
160 Then seek out Bumblebee in Navar, he will tell you... 223 Then seek out Bumblebee in Navar, he will tell you...
161 @match I did the quest 224 @match I did the quest
175When 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
176internal 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
177state 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
178be careful when triggering the connection from other objects. 241be careful when triggering the connection from other objects.
179 242
180When 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
181and 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>
182let 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.
183 247
184Trigger 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.
185 260
186=item @addtopic topic 261=item @addtopic topic
187 262
188Adds 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
189returned. 264returned.
207 my @replies; 282 my @replies;
208 my @match; # @match/@parse command results 283 my @match; # @match/@parse command results
209 284
210 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {}; 285 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {};
211 my $flag = $self->{ob}{dialog_flag} ||= {}; 286 my $flag = $self->{ob}{dialog_flag} ||= {};
287
288 my @find;
212 289
213 my %vars = ( 290 my %vars = (
214 who => $self->{ob}, 291 who => $self->{ob},
215 npc => $self->{npc}, 292 npc => $self->{npc},
216 state => $state, 293 state => $state,
217 flag => $flag, 294 flag => $flag,
218 msg => $msg, 295 msg => $msg,
219 match => \@match, 296 match => \@match,
297 find => \@find,
220 ); 298 );
221 299
222 local $self->{ob}{record_replies} = \@replies; 300 local $self->{ob}{record_replies} = \@replies;
223 301
224 # now execute @-commands (which can result in a no-match) 302 # now execute @-commands (which can result in a no-match)
231 or next topic; 309 or next topic;
232 310
233 } elsif ($cmd eq "comment") { 311 } elsif ($cmd eq "comment") {
234 # nop 312 # nop
235 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
236 } elsif ($cmd eq "cond") { 320 } elsif ($cmd eq "cond") {
237 cf::safe_eval $args, %vars 321 cf::safe_eval $args, %vars
238 or next topic; 322 or next topic;
239 323
240 } elsif ($cmd eq "eval") { 324 } elsif ($cmd eq "eval") {
241 cf::safe_eval $args, %vars; 325 cf::safe_eval $args, %vars;
242 warn "\@eval evaluation error: $@\n" if $@; 326 warn "\@eval evaluation error: $@\n" if $@;
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 $@;
243 340
244 } elsif ($cmd eq "msg") { 341 } elsif ($cmd eq "msg") {
245 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)]; 342 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)];
246 343
247 } elsif ($cmd eq "setflag") { 344 } elsif ($cmd eq "setflag") {
254 $value ? $state->{$name} = $value 351 $value ? $state->{$name} = $value
255 : delete $state->{$name}; 352 : delete $state->{$name};
256 353
257 } elsif ($cmd eq "ifflag") { 354 } elsif ($cmd eq "ifflag") {
258 my ($name, $value) = split /\s+/, $args, 2; 355 my ($name, $value) = split /\s+/, $args, 2;
259 $flag->{$name} eq $value 356 defined $value ? $flag->{$name} eq $value
357 : $flag->{$name}
260 or next topic; 358 or next topic;
261 359
262 } elsif ($cmd eq "ifstate") { 360 } elsif ($cmd eq "ifstate") {
263 my ($name, $value) = split /\s+/, $args, 2; 361 my ($name, $value) = split /\s+/, $args, 2;
264 $state->{$name} eq $value 362 $state->{$name} eq $value
265 or next topic; 363 or next topic;
266 364
267 } elsif ($cmd eq "trigger") { 365 } elsif ($cmd eq "trigger") {
268 my ($con, $state) = split /\s+/, $args, 2; 366 my ($con, $state) = split /\s+/, $args, 2;
269 $con = $con * 1;
270 367
271 if (defined $state) { 368 if (defined $state) {
272 $self->{npc}->map->trigger ($args, $state); 369 $self->{npc}->map->trigger ($con, $state, $self->{npc}, $self->{ob});
273 } else { 370 } else {
274 my $rvalue = \$self->{npc}{dialog_trigger}{$con}; 371 my $rvalue = \$self->{npc}{dialog_trigger}{$con+0};
275 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue); 372 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue, $self->{npc}, $self->{ob});
276 } 373 }
277 374
278 } elsif ($cmd eq "addtopic") { 375 } elsif ($cmd eq "addtopic") {
279 push @kw, split /\|/, $args; 376 push @kw, split /\|/, $args;
280 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic}; 377 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic};
288 } 385 }
289 } 386 }
290 387
291 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state; 388 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state;
292 delete $self->{ob}{dialog_flag} unless %$flag; 389 delete $self->{ob}{dialog_flag} unless %$flag;
293
294 # combine lines into paragraphs
295 $reply =~ s/(?<=\S)\n(?=\w)/ /g;
296 $reply =~ s/\n\n/\n/g;
297 390
298 # ignores flags and npc from replies 391 # ignores flags and npc from replies
299 $reply = join "\n", (map $_->[1], @replies), $reply; 392 $reply = join "\n", (map $_->[1], @replies), $reply;
300 393
301 # now mark up all matching keywords 394 # now mark up all matching keywords
306 last; 399 last;
307 } 400 }
308 } 401 }
309 } 402 }
310 403
404 $self->{npc}->use_trigger ($self->{ob})
405 if $self->{npc}->type == cf::MAGIC_EAR;
406
311 return wantarray ? ($reply, @kw) : $reply; 407 return wantarray ? ($reply, @kw) : $reply;
312 } 408 }
313 } 409 }
314 } 410 }
315 411

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines