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.9 by root, Mon Apr 21 06:35:26 2008 UTC vs.
Revision 1.21 by root, Fri Mar 19 22:16:27 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,
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
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.
217 251
218=item @playersound face-name 252=item @playersound face-name
219 253
251 my @match; # @match/@parse command results 285 my @match; # @match/@parse command results
252 286
253 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {}; 287 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {};
254 my $flag = $self->{ob}{dialog_flag} ||= {}; 288 my $flag = $self->{ob}{dialog_flag} ||= {};
255 289
290 my @find;
291
256 my %vars = ( 292 my %vars = (
257 who => $self->{ob}, 293 who => $self->{ob},
258 npc => $self->{npc}, 294 npc => $self->{npc},
295 map => $self->{npc}->map,
259 state => $state, 296 state => $state,
260 flag => $flag, 297 flag => $flag,
261 msg => $msg, 298 msg => $msg,
262 match => \@match, 299 match => \@match,
300 find => \@find,
263 ); 301 );
264 302
265 local $self->{ob}{record_replies} = \@replies; 303 local $self->{ob}{record_replies} = \@replies;
266 304
267 # now execute @-commands (which can result in a no-match) 305 # now execute @-commands (which can result in a no-match)
288 326
289 } elsif ($cmd eq "eval") { 327 } elsif ($cmd eq "eval") {
290 cf::safe_eval $args, %vars; 328 cf::safe_eval $args, %vars;
291 warn "\@eval evaluation error: $@\n" if $@; 329 warn "\@eval evaluation error: $@\n" if $@;
292 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
293 } elsif ($cmd eq "msg") { 344 } elsif ($cmd eq "msg") {
294 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)]; 345 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)];
295 346
296 } elsif ($cmd eq "setflag") { 347 } elsif ($cmd eq "setflag") {
297 my ($name, $value) = split /\s+/, $args, 2; 348 my ($name, $value) = split /\s+/, $args, 2;
298 $value ? $flag->{$name} = $value 349 defined $value ? $flag->{$name} = $value
299 : delete $flag->{$name}; 350 : delete $flag->{$name};
300 351
301 } elsif ($cmd eq "setstate") { 352 } elsif ($cmd eq "setstate") {
302 my ($name, $value) = split /\s+/, $args, 2; 353 my ($name, $value) = split /\s+/, $args, 2;
303 $value ? $state->{$name} = $value 354 defined $value ? $state->{$name} = $value
304 : delete $state->{$name}; 355 : delete $state->{$name};
305 356
306 } elsif ($cmd eq "ifflag") { 357 } elsif ($cmd eq "ifflag") {
307 my ($name, $value) = split /\s+/, $args, 2; 358 my ($name, $value) = split /\s+/, $args, 2;
308 $flag->{$name} eq $value 359 defined $value ? $flag->{$name} eq $value
360 : $flag->{$name}
309 or next topic; 361 or next topic;
310 362
311 } elsif ($cmd eq "ifstate") { 363 } elsif ($cmd eq "ifstate") {
312 my ($name, $value) = split /\s+/, $args, 2; 364 my ($name, $value) = split /\s+/, $args, 2;
313 $state->{$name} eq $value 365 defined $value ? $state->{$name} eq $value
366 : $state->{$name}
314 or next topic; 367 or next topic;
315 368
316 } elsif ($cmd eq "trigger") { 369 } elsif ($cmd eq "trigger") {
317 my ($con, $state) = split /\s+/, $args, 2; 370 my ($con, $state) = split /\s+/, $args, 2;
318 $con = $con * 1;
319 371
320 if (defined $state) { 372 if (defined $state) {
321 $self->{npc}->map->trigger ($args, $state); 373 $self->{npc}->map->trigger ($con, $state, $self->{npc}, $self->{ob});
322 } else { 374 } else {
323 my $rvalue = \$self->{npc}{dialog_trigger}{$con}; 375 my $rvalue = \$self->{npc}{dialog_trigger}{$con+0};
324 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue); 376 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue, $self->{npc}, $self->{ob});
325 } 377 }
326 378
327 } elsif ($cmd eq "addtopic") { 379 } elsif ($cmd eq "addtopic") {
328 push @kw, split /\|/, $args; 380 push @kw, split /\|/, $args;
329 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic}; 381 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic};
337 } 389 }
338 } 390 }
339 391
340 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state; 392 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state;
341 delete $self->{ob}{dialog_flag} unless %$flag; 393 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 394
347 # ignores flags and npc from replies 395 # ignores flags and npc from replies
348 $reply = join "\n", (map $_->[1], @replies), $reply; 396 $reply = join "\n", (map $_->[1], @replies), $reply;
349 397
350 # now mark up all matching keywords 398 # now mark up all matching keywords
355 last; 403 last;
356 } 404 }
357 } 405 }
358 } 406 }
359 407
408 $self->{npc}->use_trigger ($self->{ob})
409 if $self->{npc}->type == cf::MAGIC_EAR;
410
360 return wantarray ? ($reply, @kw) : $reply; 411 return wantarray ? ($reply, @kw) : $reply;
361 } 412 }
362 } 413 }
363 } 414 }
364 415

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines