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.17 by root, Mon Oct 26 02:55:07 2009 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 matched into the C<@find> array variable.
162
163When you want to skip the match when no objects have been found, combine
164C<@find> with C<@cond>:
165
166 @match see my spellbook
167 @find type=SPELLBOOK in inv
168 @cond @find
169 It looks dirty.
170 @match see my spellbook
171 I can't see any, where do you have it?
120 172
121=item @setstate state value 173=item @setstate state value
122 174
123Sets the named state C<state> to the given C<value>. State values are 175Sets 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 176associated 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 199associated with a specific player and can be seen by all NPCs. with
148respect to a particular player, which makes them suitable to store quest 200respect to a particular player, which makes them suitable to store quest
149markers and other information (e.g. reputation/alignment). Flags are 201markers and other information (e.g. reputation/alignment). Flags are
150persistent over the lifetime of a player, so be careful :) 202persistent over the lifetime of a player, so be careful :)
151 203
204Perversely enough, using C<@setfflag> without a C<value> clears the flag
205as if it was never set, so always provide a flag value (e.g. C<1>) when
206you want to set the flag.
207
152See C<@ifflag> for an example. 208See C<@ifflag> for an example.
153 209
154=item @ifflag flag value 210=item @ifflag flag value
155 211
156Requires that the named C<flag> has the given C<value>, otherwise this 212Requires that the named C<flag> has the given C<value>, otherwise this
157topic is skipped. For more complex comparisons, see C<@cond> with 213topic is skipped. For more complex comparisons, see C<@cond> with
158C<$flag>. Example: 214C<$flag>.
215
216If no C<value> is given, then the ifflag succeeds when the flag is true.
217
218Example:
159 219
160 @match I want to do the quest! 220 @match I want to do the quest!
161 @setflag kings_quest 1 221 @setflag kings_quest 1
162 Then seek out Bumblebee in Navar, he will tell you... 222 Then seek out Bumblebee in Navar, he will tell you...
163 @match I did the quest 223 @match I did the quest
177When the state argument is omitted the trigger is stateful and retains an 237When 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 238internal 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 239state won't be changed when the connection is triggered by other triggers. So
180be careful when triggering the connection from other objects. 240be careful when triggering the connection from other objects.
181 241
182When a state argument is given it should be either 0 or 1. 1 will 'push' the connection 242When 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 243C<!= 0> will 'push' the connection (in general, you should specify C<1>
184let a npc control a door. 244for this) and C<0> will 'release' the connection. This is useful for
245example when you want to let an NPC control a door.
185 246
186Trigger all objects with the given connected-id by 'releasing' the connection. 247Trigger all objects with the given connected-id by 'releasing' the connection.
248
249=item @playersound face-name
250
251Plays the given sound face (either an alias or sound file path) so that
252only the player talking to the npc can hear it.
253
254=item @npcsound face-name
255
256Plays the given sound face (either an alias or sound file path) as if
257the npc had made that sound, i.e. it will be located at the npc and all
258players near enough can hear it.
187 259
188=item @addtopic topic 260=item @addtopic topic
189 261
190Adds the given topic names (separated by C<|>) to the list of topics 262Adds the given topic names (separated by C<|>) to the list of topics
191returned. 263returned.
209 my @replies; 281 my @replies;
210 my @match; # @match/@parse command results 282 my @match; # @match/@parse command results
211 283
212 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {}; 284 my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {};
213 my $flag = $self->{ob}{dialog_flag} ||= {}; 285 my $flag = $self->{ob}{dialog_flag} ||= {};
286
287 my @find;
214 288
215 my %vars = ( 289 my %vars = (
216 who => $self->{ob}, 290 who => $self->{ob},
217 npc => $self->{npc}, 291 npc => $self->{npc},
218 state => $state, 292 state => $state,
233 or next topic; 307 or next topic;
234 308
235 } elsif ($cmd eq "comment") { 309 } elsif ($cmd eq "comment") {
236 # nop 310 # nop
237 311
312 } elsif ($cmd eq "playersound") {
313 $self->{ob}->contr->play_sound (cf::sound::find $args);
314
315 } elsif ($cmd eq "npcsound") {
316 $self->{npc}->play_sound (cf::sound::find $args);
317
238 } elsif ($cmd eq "cond") { 318 } elsif ($cmd eq "cond") {
239 cf::safe_eval $args, %vars 319 cf::safe_eval $args, %vars
240 or next topic; 320 or next topic;
241 321
242 } elsif ($cmd eq "eval") { 322 } elsif ($cmd eq "eval") {
243 cf::safe_eval $args, %vars; 323 cf::safe_eval $args, %vars;
244 warn "\@eval evaluation error: $@\n" if $@; 324 warn "\@eval evaluation error: $@\n" if $@;
325
326 } elsif ($cmd eq "check") {
327 eval {
328 cf::match::match $args, $self->{ob}, $self->{npc}, $self->{ob}
329 or next topic;
330 };
331 warn "\@check evaluation error: $@\n" if $@;
332
333 } elsif ($cmd eq "find") {
334 @find = eval {
335 cf::match::match $args, $self->{ob}, $self->{npc}, $self->{ob}
336 };
337 warn "\@find evaluation error: $@\n" if $@;
245 338
246 } elsif ($cmd eq "msg") { 339 } elsif ($cmd eq "msg") {
247 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)]; 340 push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)];
248 341
249 } elsif ($cmd eq "setflag") { 342 } elsif ($cmd eq "setflag") {
256 $value ? $state->{$name} = $value 349 $value ? $state->{$name} = $value
257 : delete $state->{$name}; 350 : delete $state->{$name};
258 351
259 } elsif ($cmd eq "ifflag") { 352 } elsif ($cmd eq "ifflag") {
260 my ($name, $value) = split /\s+/, $args, 2; 353 my ($name, $value) = split /\s+/, $args, 2;
261 $flag->{$name} eq $value 354 defined $value ? $flag->{$name} eq $value
355 : $flag->{$name}
262 or next topic; 356 or next topic;
263 357
264 } elsif ($cmd eq "ifstate") { 358 } elsif ($cmd eq "ifstate") {
265 my ($name, $value) = split /\s+/, $args, 2; 359 my ($name, $value) = split /\s+/, $args, 2;
266 $state->{$name} eq $value 360 $state->{$name} eq $value
267 or next topic; 361 or next topic;
268 362
269 } elsif ($cmd eq "trigger") { 363 } elsif ($cmd eq "trigger") {
270 my ($con, $state) = split /\s+/, $args, 2; 364 my ($con, $state) = split /\s+/, $args, 2;
271 $con = $con * 1;
272 365
273 if (defined $state) { 366 if (defined $state) {
274 $self->{npc}->map->trigger ($args, $state); 367 $self->{npc}->map->trigger ($con, $state, $self->{npc}, $self->{ob});
275 } else { 368 } else {
276 my $rvalue = \$self->{npc}{dialog_trigger}{$con}; 369 my $rvalue = \$self->{npc}{dialog_trigger}{$con+0};
277 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue); 370 $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue, $self->{npc}, $self->{ob});
278 } 371 }
279 372
280 } elsif ($cmd eq "addtopic") { 373 } elsif ($cmd eq "addtopic") {
281 push @kw, split /\|/, $args; 374 push @kw, split /\|/, $args;
282 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic}; 375 $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic};
290 } 383 }
291 } 384 }
292 385
293 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state; 386 delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state;
294 delete $self->{ob}{dialog_flag} unless %$flag; 387 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 388
300 # ignores flags and npc from replies 389 # ignores flags and npc from replies
301 $reply = join "\n", (map $_->[1], @replies), $reply; 390 $reply = join "\n", (map $_->[1], @replies), $reply;
302 391
303 # now mark up all matching keywords 392 # now mark up all matching keywords
308 last; 397 last;
309 } 398 }
310 } 399 }
311 } 400 }
312 401
402 $self->{npc}->use_trigger ($self->{ob})
403 if $self->{npc}->type == cf::MAGIC_EAR;
404
313 return wantarray ? ($reply, @kw) : $reply; 405 return wantarray ? ($reply, @kw) : $reply;
314 } 406 }
315 } 407 }
316 } 408 }
317 409

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines