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.22 by root, Tue May 4 22:49:21 2010 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines