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.22 by root, Tue May 4 22:49:21 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 common::sense;
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,
86 82
87=item $who - The cf::object::player object that initiated the dialogue. 83=item $who - The cf::object::player object that initiated the dialogue.
88 84
89=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.
90 86
87=item $map - The map the NPC (not the player) is on.
88
91=item $msg - The actual message as passed to this method. 89=item $msg - The actual message as passed to this method.
92 90
93=item $match - An arrayref with previous results from C<@parse>. 91=item $match - An arrayref with previous results from C<@parse>.
94 92
95=item $state - A hashref that stores state variables associated 93=item $state - A hashref that stores state variables associated
100 98
101=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
102can 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
103useful 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>.
104 102
103=item $find - see @find, below.
104
105=back 105=back
106 106
107The environment is that standard "map scripting environment", which is 107The environment is that standard "map scripting environment", which is
108limited in the type of constructs allowed (no loops, for example). 108limited in the type of constructs allowed (no loops, for example).
109 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
110=item @eval perl 140=item @eval perl
111 141
112Like C<@cond>, but proceed regardless of the outcome. 142Like C<@cond>, but proceed regardless of the outcome.
113 143
114=item @msg perl 144=item @msg perl
115 145
116Like 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
117the 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?
118 175
119=item @setstate state value 176=item @setstate state value
120 177
121Sets 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
122associated 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
127See C<@ifstate> for an example. 184See C<@ifstate> for an example.
128 185
129=item @ifstate state value 186=item @ifstate state value
130 187
131Requires 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
132topic is skipped. For more complex comparisons, see C<@cond> with 189topic is skipped. For more complex comparisons, see C<@cond> with
133C<$state>. Example: 190C<$state>. Example:
134 191
135 @match quest 192 @match quest
136 @setstate question quest 193 @setstate question quest
137 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?
145associated 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
146respect to a particular player, which makes them suitable to store quest 203respect to a particular player, which makes them suitable to store quest
147markers and other information (e.g. reputation/alignment). Flags are 204markers and other information (e.g. reputation/alignment). Flags are
148persistent over the lifetime of a player, so be careful :) 205persistent over the lifetime of a player, so be careful :)
149 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
150See C<@ifflag> for an example. 211See C<@ifflag> for an example.
151 212
152=item @ifflag flag value 213=item @ifflag flag value
153 214
154Requires 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
155topic is skipped. For more complex comparisons, see C<@cond> with 216topic is skipped. For more complex comparisons, see C<@cond> with
156C<$flag>. Example: 217C<$flag>.
218
219If no C<value> is given, then the ifflag succeeds when the flag is true.
220
221Example:
157 222
158 @match I want to do the quest! 223 @match I want to do the quest!
159 @setflag kings_quest 1 224 @setflag kings_quest 1
160 Then seek out Bumblebee in Navar, he will tell you... 225 Then seek out Bumblebee in Navar, he will tell you...
161 @match I did the quest 226 @match I did the quest
175When 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
176internal 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
177state 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
178be careful when triggering the connection from other objects. 243be careful when triggering the connection from other objects.
179 244
180When 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
181and 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>
182let 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.
183 249
184Trigger 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.
185 262
186=item @addtopic topic 263=item @addtopic topic
187 264
188Adds 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
189returned. 266returned.
208 my @match; # @match/@parse command results 285 my @match; # @match/@parse command results
209 286
210 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {}; 287 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {};
211 my $flag = $self->{ob}{dialog_flag} ||= {}; 288 my $flag = $self->{ob}{dialog_flag} ||= {};
212 289
290 my @find;
291
213 my %vars = ( 292 my %vars = (
214 who => $self->{ob}, 293 who => $self->{ob},
215 npc => $self->{npc}, 294 npc => $self->{npc},
295 map => $self->{npc}->map,
216 state => $state, 296 state => $state,
217 flag => $flag, 297 flag => $flag,
218 msg => $msg, 298 msg => $msg,
219 match => \@match, 299 match => \@match,
300 find => \@find,
220 ); 301 );
221 302
222 local $self->{ob}{record_replies} = \@replies; 303 local $self->{ob}{record_replies} = \@replies;
223 304
224 # now execute @-commands (which can result in a no-match) 305 # now execute @-commands (which can result in a no-match)
231 or next topic; 312 or next topic;
232 313
233 } elsif ($cmd eq "comment") { 314 } elsif ($cmd eq "comment") {
234 # nop 315 # nop
235 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
236 } elsif ($cmd eq "cond") { 323 } elsif ($cmd eq "cond") {
237 cf::safe_eval $args, %vars 324 cf::safe_eval $args, %vars
238 or next topic; 325 or next topic;
239 326
240 } elsif ($cmd eq "eval") { 327 } elsif ($cmd eq "eval") {
241 cf::safe_eval $args, %vars; 328 cf::safe_eval $args, %vars;
242 warn "\@eval evaluation error: $@\n" if $@; 329 warn "\@eval evaluation error: $@\n" if $@;
243 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
244 } elsif ($cmd eq "msg") { 344 } elsif ($cmd eq "msg") {
245 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)]; 345 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)];
246 346
247 } elsif ($cmd eq "setflag") { 347 } elsif ($cmd eq "setflag") {
248 my ($name, $value) = split /\s+/, $args, 2; 348 my ($name, $value) = split /\s+/, $args, 2;
249 $value ? $flag->{$name} = $value 349 defined $value ? $flag->{$name} = $value
250 : delete $flag->{$name}; 350 : delete $flag->{$name};
251 351
252 } elsif ($cmd eq "setstate") { 352 } elsif ($cmd eq "setstate") {
253 my ($name, $value) = split /\s+/, $args, 2; 353 my ($name, $value) = split /\s+/, $args, 2;
254 $value ? $state->{$name} = $value 354 defined $value ? $state->{$name} = $value
255 : delete $state->{$name}; 355 : delete $state->{$name};
256 356
257 } elsif ($cmd eq "ifflag") { 357 } elsif ($cmd eq "ifflag") {
258 my ($name, $value) = split /\s+/, $args, 2; 358 my ($name, $value) = split /\s+/, $args, 2;
259 $flag->{$name} eq $value 359 defined $value ? $flag->{$name} eq $value
360 : $flag->{$name}
260 or next topic; 361 or next topic;
261 362
262 } elsif ($cmd eq "ifstate") { 363 } elsif ($cmd eq "ifstate") {
263 my ($name, $value) = split /\s+/, $args, 2; 364 my ($name, $value) = split /\s+/, $args, 2;
264 $state->{$name} eq $value 365 defined $value ? $state->{$name} eq $value
366 : $state->{$name}
265 or next topic; 367 or next topic;
266 368
267 } elsif ($cmd eq "trigger") { 369 } elsif ($cmd eq "trigger") {
268 my ($con, $state) = split /\s+/, $args, 2; 370 my ($con, $state) = split /\s+/, $args, 2;
269 $con = $con * 1;
270 371
271 if (defined $state) { 372 if (defined $state) {
272 $self->{npc}->map->trigger ($args, $state); 373 $self->{npc}->map->trigger ($con, $state, $self->{npc}, $self->{ob});
273 } else { 374 } else {
274 my $rvalue = \$self->{npc}{dialog_trigger}{$con}; 375 my $rvalue = \$self->{npc}{dialog_trigger}{$con+0};
275 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue); 376 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue, $self->{npc}, $self->{ob});
276 } 377 }
277 378
278 } elsif ($cmd eq "addtopic") { 379 } elsif ($cmd eq "addtopic") {
279 push @kw, split /\|/, $args; 380 push @kw, split /\|/, $args;
280 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic}; 381 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic};
288 } 389 }
289 } 390 }
290 391
291 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state; 392 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state;
292 delete $self->{ob}{dialog_flag} unless %$flag; 393 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 394
298 # ignores flags and npc from replies 395 # ignores flags and npc from replies
299 $reply = join "\n", (map $_->[1], @replies), $reply; 396 $reply = join "\n", (map $_->[1], @replies), $reply;
300 397
301 # now mark up all matching keywords 398 # now mark up all matching keywords
306 last; 403 last;
307 } 404 }
308 } 405 }
309 } 406 }
310 407
408 $self->{npc}->use_trigger ($self->{ob})
409 if $self->{npc}->type == cf::MAGIC_EAR;
410
311 return wantarray ? ($reply, @kw) : $reply; 411 return wantarray ? ($reply, @kw) : $reply;
312 } 412 }
313 } 413 }
314 } 414 }
315 415

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines