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.5 by root, Sat Jun 16 23:22:59 2007 UTC vs.
Revision 1.19 by root, Fri Feb 5 01:26:35 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,
102 96
103=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
104can 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
105useful 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>.
106 100
101=item $find - see @find, below.
102
107=back 103=back
108 104
109The environment is that standard "map scripting environment", which is 105The environment is that standard "map scripting environment", which is
110limited in the type of constructs allowed (no loops, for example). 106limited in the type of constructs allowed (no loops, for example).
111 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
112=item @eval perl 138=item @eval perl
113 139
114Like C<@cond>, but proceed regardless of the outcome. 140Like C<@cond>, but proceed regardless of the outcome.
115 141
116=item @msg perl 142=item @msg perl
117 143
118Like 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
119the 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?
120 173
121=item @setstate state value 174=item @setstate state value
122 175
123Sets 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
124associated 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
147associated 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
148respect to a particular player, which makes them suitable to store quest 201respect to a particular player, which makes them suitable to store quest
149markers and other information (e.g. reputation/alignment). Flags are 202markers and other information (e.g. reputation/alignment). Flags are
150persistent over the lifetime of a player, so be careful :) 203persistent over the lifetime of a player, so be careful :)
151 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
152See C<@ifflag> for an example. 209See C<@ifflag> for an example.
153 210
154=item @ifflag flag value 211=item @ifflag flag value
155 212
156Requires 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
157topic is skipped. For more complex comparisons, see C<@cond> with 214topic is skipped. For more complex comparisons, see C<@cond> with
158C<$flag>. Example: 215C<$flag>.
216
217If no C<value> is given, then the ifflag succeeds when the flag is true.
218
219Example:
159 220
160 @match I want to do the quest! 221 @match I want to do the quest!
161 @setflag kings_quest 1 222 @setflag kings_quest 1
162 Then seek out Bumblebee in Navar, he will tell you... 223 Then seek out Bumblebee in Navar, he will tell you...
163 @match I did the quest 224 @match I did the quest
177When 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
178internal 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
179state 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
180be careful when triggering the connection from other objects. 241be careful when triggering the connection from other objects.
181 242
182When 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
183and 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>
184let 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.
185 247
186Trigger 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.
187 260
188=item @addtopic topic 261=item @addtopic topic
189 262
190Adds 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
191returned. 264returned.
209 my @replies; 282 my @replies;
210 my @match; # @match/@parse command results 283 my @match; # @match/@parse command results
211 284
212 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {}; 285 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {};
213 my $flag = $self->{ob}{dialog_flag} ||= {}; 286 my $flag = $self->{ob}{dialog_flag} ||= {};
287
288 my @find;
214 289
215 my %vars = ( 290 my %vars = (
216 who => $self->{ob}, 291 who => $self->{ob},
217 npc => $self->{npc}, 292 npc => $self->{npc},
218 state => $state, 293 state => $state,
219 flag => $flag, 294 flag => $flag,
220 msg => $msg, 295 msg => $msg,
221 match => \@match, 296 match => \@match,
297 find => \@find,
222 ); 298 );
223 299
224 local $self->{ob}{record_replies} = \@replies; 300 local $self->{ob}{record_replies} = \@replies;
225 301
226 # now execute @-commands (which can result in a no-match) 302 # now execute @-commands (which can result in a no-match)
233 or next topic; 309 or next topic;
234 310
235 } elsif ($cmd eq "comment") { 311 } elsif ($cmd eq "comment") {
236 # nop 312 # nop
237 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
238 } elsif ($cmd eq "cond") { 320 } elsif ($cmd eq "cond") {
239 cf::safe_eval $args, %vars 321 cf::safe_eval $args, %vars
240 or next topic; 322 or next topic;
241 323
242 } elsif ($cmd eq "eval") { 324 } elsif ($cmd eq "eval") {
243 cf::safe_eval $args, %vars; 325 cf::safe_eval $args, %vars;
244 warn "\@eval evaluation error: $@\n" if $@; 326 warn "\@eval evaluation error: $@\n" if $@;
245 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 $@;
340
246 } elsif ($cmd eq "msg") { 341 } elsif ($cmd eq "msg") {
247 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)]; 342 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)];
248 343
249 } elsif ($cmd eq "setflag") { 344 } elsif ($cmd eq "setflag") {
250 my ($name, $value) = split /\s+/, $args, 2; 345 my ($name, $value) = split /\s+/, $args, 2;
251 $value ? $flag->{$name} = $value 346 defined $value ? $flag->{$name} = $value
252 : delete $flag->{$name}; 347 : delete $flag->{$name};
253 348
254 } elsif ($cmd eq "setstate") { 349 } elsif ($cmd eq "setstate") {
255 my ($name, $value) = split /\s+/, $args, 2; 350 my ($name, $value) = split /\s+/, $args, 2;
256 $value ? $state->{$name} = $value 351 defined $value ? $state->{$name} = $value
257 : delete $state->{$name}; 352 : delete $state->{$name};
258 353
259 } elsif ($cmd eq "ifflag") { 354 } elsif ($cmd eq "ifflag") {
260 my ($name, $value) = split /\s+/, $args, 2; 355 my ($name, $value) = split /\s+/, $args, 2;
261 $flag->{$name} eq $value 356 defined $value ? $flag->{$name} eq $value
357 : $flag->{$name}
262 or next topic; 358 or next topic;
263 359
264 } elsif ($cmd eq "ifstate") { 360 } elsif ($cmd eq "ifstate") {
265 my ($name, $value) = split /\s+/, $args, 2; 361 my ($name, $value) = split /\s+/, $args, 2;
266 $state->{$name} eq $value 362 $state->{$name} eq $value
267 or next topic; 363 or next topic;
268 364
269 } elsif ($cmd eq "trigger") { 365 } elsif ($cmd eq "trigger") {
270 my ($con, $state) = split /\s+/, $args, 2; 366 my ($con, $state) = split /\s+/, $args, 2;
271 $con = $con * 1;
272 367
273 if (defined $state) { 368 if (defined $state) {
274 $self->{npc}->map->trigger ($args, $state); 369 $self->{npc}->map->trigger ($con, $state, $self->{npc}, $self->{ob});
275 } else { 370 } else {
276 my $rvalue = \$self->{npc}{dialog_trigger}{$con}; 371 my $rvalue = \$self->{npc}{dialog_trigger}{$con+0};
277 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue); 372 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue, $self->{npc}, $self->{ob});
278 } 373 }
279 374
280 } elsif ($cmd eq "addtopic") { 375 } elsif ($cmd eq "addtopic") {
281 push @kw, split /\|/, $args; 376 push @kw, split /\|/, $args;
282 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic}; 377 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic};
290 } 385 }
291 } 386 }
292 387
293 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state; 388 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state;
294 delete $self->{ob}{dialog_flag} unless %$flag; 389 delete $self->{ob}{dialog_flag} unless %$flag;
295
296 # combine lines into paragraphs
297 $reply =~ s/(?<=\S)\n(?=\w)/ /g;
298 $reply =~ s/\n\n/\n/g;
299 390
300 # ignores flags and npc from replies 391 # ignores flags and npc from replies
301 $reply = join "\n", (map $_->[1], @replies), $reply; 392 $reply = join "\n", (map $_->[1], @replies), $reply;
302 393
303 # now mark up all matching keywords 394 # now mark up all matching keywords
308 last; 399 last;
309 } 400 }
310 } 401 }
311 } 402 }
312 403
404 $self->{npc}->use_trigger ($self->{ob})
405 if $self->{npc}->type == cf::MAGIC_EAR;
406
313 return wantarray ? ($reply, @kw) : $reply; 407 return wantarray ? ($reply, @kw) : $reply;
314 } 408 }
315 } 409 }
316 } 410 }
317 411

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines