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.6 by elmex, Wed Aug 8 07:55:57 2007 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
121 119
122You may want to change the C<name> method there to something like C<title>, 120You may want to change the C<name> method there to something like C<title>,
123C<slaying> or any other method that is allowed to be called on a 121C<slaying> or any other method that is allowed to be called on a
124C<cf::object> here. 122C<cf::object> here.
125 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
126=back 138=back
127 139
128=item @eval perl 140=item @eval perl
129 141
130Like C<@cond>, but proceed regardless of the outcome. 142Like C<@cond>, but proceed regardless of the outcome.
131 143
132=item @msg perl 144=item @msg perl
133 145
134Like 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
135the 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?
136 175
137=item @setstate state value 176=item @setstate state value
138 177
139Sets 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
140associated 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
145See C<@ifstate> for an example. 184See C<@ifstate> for an example.
146 185
147=item @ifstate state value 186=item @ifstate state value
148 187
149Requires 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
150topic is skipped. For more complex comparisons, see C<@cond> with 189topic is skipped. For more complex comparisons, see C<@cond> with
151C<$state>. Example: 190C<$state>. Example:
152 191
153 @match quest 192 @match quest
154 @setstate question quest 193 @setstate question quest
155 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?
163associated 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
164respect to a particular player, which makes them suitable to store quest 203respect to a particular player, which makes them suitable to store quest
165markers and other information (e.g. reputation/alignment). Flags are 204markers and other information (e.g. reputation/alignment). Flags are
166persistent over the lifetime of a player, so be careful :) 205persistent over the lifetime of a player, so be careful :)
167 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
168See C<@ifflag> for an example. 211See C<@ifflag> for an example.
169 212
170=item @ifflag flag value 213=item @ifflag flag value
171 214
172Requires 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
173topic is skipped. For more complex comparisons, see C<@cond> with 216topic is skipped. For more complex comparisons, see C<@cond> with
174C<$flag>. Example: 217C<$flag>.
218
219If no C<value> is given, then the ifflag succeeds when the flag is true.
220
221Example:
175 222
176 @match I want to do the quest! 223 @match I want to do the quest!
177 @setflag kings_quest 1 224 @setflag kings_quest 1
178 Then seek out Bumblebee in Navar, he will tell you... 225 Then seek out Bumblebee in Navar, he will tell you...
179 @match I did the quest 226 @match I did the quest
193When 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
194internal 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
195state 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
196be careful when triggering the connection from other objects. 243be careful when triggering the connection from other objects.
197 244
198When 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
199and 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>
200let 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.
201 249
202Trigger 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.
203 262
204=item @addtopic topic 263=item @addtopic topic
205 264
206Adds 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
207returned. 266returned.
226 my @match; # @match/@parse command results 285 my @match; # @match/@parse command results
227 286
228 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {}; 287 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {};
229 my $flag = $self->{ob}{dialog_flag} ||= {}; 288 my $flag = $self->{ob}{dialog_flag} ||= {};
230 289
290 my @find;
291
231 my %vars = ( 292 my %vars = (
232 who => $self->{ob}, 293 who => $self->{ob},
233 npc => $self->{npc}, 294 npc => $self->{npc},
295 map => $self->{npc}->map,
234 state => $state, 296 state => $state,
235 flag => $flag, 297 flag => $flag,
236 msg => $msg, 298 msg => $msg,
237 match => \@match, 299 match => \@match,
300 find => \@find,
238 ); 301 );
239 302
240 local $self->{ob}{record_replies} = \@replies; 303 local $self->{ob}{record_replies} = \@replies;
241 304
242 # now execute @-commands (which can result in a no-match) 305 # now execute @-commands (which can result in a no-match)
249 or next topic; 312 or next topic;
250 313
251 } elsif ($cmd eq "comment") { 314 } elsif ($cmd eq "comment") {
252 # nop 315 # nop
253 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
254 } elsif ($cmd eq "cond") { 323 } elsif ($cmd eq "cond") {
255 cf::safe_eval $args, %vars 324 cf::safe_eval $args, %vars
256 or next topic; 325 or next topic;
257 326
258 } elsif ($cmd eq "eval") { 327 } elsif ($cmd eq "eval") {
259 cf::safe_eval $args, %vars; 328 cf::safe_eval $args, %vars;
260 warn "\@eval evaluation error: $@\n" if $@; 329 warn "\@eval evaluation error: $@\n" if $@;
261 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
262 } elsif ($cmd eq "msg") { 344 } elsif ($cmd eq "msg") {
263 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)]; 345 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)];
264 346
265 } elsif ($cmd eq "setflag") { 347 } elsif ($cmd eq "setflag") {
266 my ($name, $value) = split /\s+/, $args, 2; 348 my ($name, $value) = split /\s+/, $args, 2;
267 $value ? $flag->{$name} = $value 349 defined $value ? $flag->{$name} = $value
268 : delete $flag->{$name}; 350 : delete $flag->{$name};
269 351
270 } elsif ($cmd eq "setstate") { 352 } elsif ($cmd eq "setstate") {
271 my ($name, $value) = split /\s+/, $args, 2; 353 my ($name, $value) = split /\s+/, $args, 2;
272 $value ? $state->{$name} = $value 354 defined $value ? $state->{$name} = $value
273 : delete $state->{$name}; 355 : delete $state->{$name};
274 356
275 } elsif ($cmd eq "ifflag") { 357 } elsif ($cmd eq "ifflag") {
276 my ($name, $value) = split /\s+/, $args, 2; 358 my ($name, $value) = split /\s+/, $args, 2;
277 $flag->{$name} eq $value 359 defined $value ? $flag->{$name} eq $value
360 : $flag->{$name}
278 or next topic; 361 or next topic;
279 362
280 } elsif ($cmd eq "ifstate") { 363 } elsif ($cmd eq "ifstate") {
281 my ($name, $value) = split /\s+/, $args, 2; 364 my ($name, $value) = split /\s+/, $args, 2;
282 $state->{$name} eq $value 365 defined $value ? $state->{$name} eq $value
366 : $state->{$name}
283 or next topic; 367 or next topic;
284 368
285 } elsif ($cmd eq "trigger") { 369 } elsif ($cmd eq "trigger") {
286 my ($con, $state) = split /\s+/, $args, 2; 370 my ($con, $state) = split /\s+/, $args, 2;
287 $con = $con * 1;
288 371
289 if (defined $state) { 372 if (defined $state) {
290 $self->{npc}->map->trigger ($args, $state); 373 $self->{npc}->map->trigger ($con, $state, $self->{npc}, $self->{ob});
291 } else { 374 } else {
292 my $rvalue = \$self->{npc}{dialog_trigger}{$con}; 375 my $rvalue = \$self->{npc}{dialog_trigger}{$con+0};
293 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue); 376 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue, $self->{npc}, $self->{ob});
294 } 377 }
295 378
296 } elsif ($cmd eq "addtopic") { 379 } elsif ($cmd eq "addtopic") {
297 push @kw, split /\|/, $args; 380 push @kw, split /\|/, $args;
298 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic}; 381 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic};
306 } 389 }
307 } 390 }
308 391
309 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state; 392 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state;
310 delete $self->{ob}{dialog_flag} unless %$flag; 393 delete $self->{ob}{dialog_flag} unless %$flag;
311
312 # combine lines into paragraphs
313 $reply =~ s/(?<=\S)\n(?=\w)/ /g;
314 $reply =~ s/\n\n/\n/g;
315 394
316 # ignores flags and npc from replies 395 # ignores flags and npc from replies
317 $reply = join "\n", (map $_->[1], @replies), $reply; 396 $reply = join "\n", (map $_->[1], @replies), $reply;
318 397
319 # now mark up all matching keywords 398 # now mark up all matching keywords
324 last; 403 last;
325 } 404 }
326 } 405 }
327 } 406 }
328 407
408 $self->{npc}->use_trigger ($self->{ob})
409 if $self->{npc}->type == cf::MAGIC_EAR;
410
329 return wantarray ? ($reply, @kw) : $reply; 411 return wantarray ? ($reply, @kw) : $reply;
330 } 412 }
331 } 413 }
332 } 414 }
333 415

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines