[ViewVC] Diff of: cvs/deliantra/server/ext/NPC

Comparing deliantra/server/ext/NPC_Dialogue.pm (file contents):
Revision 1.3 by elmex, Wed Apr 4 11:45:16 2007 UTC vs.
Revision 1.20 by root, Fri Mar 19 21:40:39 2010 UTC

 =head1 DESCRIPTION
 NPC dialogue support module.
+=over 4
 =cut
 package NPC_Dialogue;
 use strict;
-sub has_dialogue($) {
-   my ($ob) = @_;
-   $ob->msg =~ /^\@match /;
-}
 sub parse_message($) {
    map [split /\n/, $_, 2],
       grep length,
          split /^\@match /m,
 }
 sub new {
    my ($class, %arg) = @_;
+   $arg{ob} = $arg{pl}->ob;
    my $self = bless {
       %arg,
    }, $class;
    $self->{match} ||= [parse_message $self->{npc}->msg];
 =item $flag - A hashref that stores flags associated with the player and
 can be seen by all NPCs (so better name your flags uniquely). This is
 useful for storing e.g. quest information. See C<@setflag> and C<@ifflag>.
+=item $find - see @find, below.
 =back
 The environment is that standard "map scripting environment", which is
 limited in the type of constructs allowed (no loops, for example).
+Here is a example:
+=over 4
+=item B<matching for an item name>
+   @match hi
+   @cond grep $_->name =~ /royalty/, $who->inv
+   You got royalties there! Wanna have!
+You may want to change the C<name> method there to something like C<title>,
+C<slaying> or any other method that is allowed to be called on a
+C<cf::object> here.
+=item B<matching for an item name and removing the matched item>
+   @match found earhorn
+   @cond grep $_->slaying =~ /Gramp's walking stick/, $who->inv
+   @eval my @g = grep { $_->slaying =~ /Gramp's walking stick/ } $who->inv; $g[0]->decrease;
+   Thanks for the earhorn!
+This example is a bit more complex. The C<@eval> statement will search
+the players inventory for the same term as the C<@cond> and then
+decreases the number of objects used there.
+(See also the map: C<scorn/houses/cornerbrook.map> for an example how this is
+used in the real world :-)
+=back
 =item @eval perl
 Like C<@cond>, but proceed regardless of the outcome.
 =item @msg perl
 Like C<@cond>, but the return value will be stringified and prepended to
-the message.
+the reply message.
+=item @check match expression
+Executes a match expression (see
+http://pod.tst.eu/http://cvs.schmorp.de/deliantra/server/lib/cf/match.pm)
+to see if it matches.
+C<self> is the npc object, C<object>, C<source> and C<originator> are the
+player communicating with the NPC.
+If the check fails, the match is skipped.
+=item @find match expression
+Like C<@check> in that it executes a match expression, but instead of
+failing, it gathers all objects into an array and provides a reference to
+the array in the C<$find> variable.
+When you want to skip the match when no objects have been found, combine
+C<@find> with C<@cond>:
+   @match see my spellbook
+   @find type=SPELLBOOK in inv
+   @cond @$find
+   It looks dirty.
+   @match see my spellbook
+   I can't see any, where do you have it?
 =item @setstate state value
 Sets the named state C<state> to the given C<value>. State values are
 associated with a specific player-NPC pair, so each NPC has its own state
 See C<@ifstate> for an example.
 =item @ifstate state value
 Requires that the named C<state> has the given C<value>, otherwise this
-topic is skipped.  For more complex comparisons, see C<@cond> with
+topic is skipped. For more complex comparisons, see C<@cond> with
 C<$state>. Example:
   @match quest
   @setstate question quest
   Do you really want to help find the magic amulet of Beeblebrox?
 associated with a specific player and can be seen by all NPCs. with
 respect to a particular player, which makes them suitable to store quest
 markers and other information (e.g. reputation/alignment). Flags are
 persistent over the lifetime of a player, so be careful :)
+Perversely enough, using C<@setfflag> without a C<value> clears the flag
+as if it was never set, so always provide a flag value (e.g. C<1>) when
+you want to set the flag.
 See C<@ifflag> for an example.
 =item @ifflag flag value
 Requires that the named C<flag> has the given C<value>, otherwise this
-topic is skipped.  For more complex comparisons, see C<@cond> with
+topic is skipped. For more complex comparisons, see C<@cond> with
-C<$flag>. Example:
+C<$flag>.
+If no C<value> is given, then the ifflag succeeds when the flag is true.
+Example:
   @match I want to do the quest!
   @setflag kings_quest 1
   Then seek out Bumblebee in Navar, he will tell you...
   @match I did the quest
 When the state argument is omitted the trigger is stateful and retains an
 internal state per connected-id. There is a limitation to the use of this: The
 state won't be changed when the connection is triggered by other triggers.  So
 be careful when triggering the connection from other objects.
-When a state argument is given it should be either 0 or 1. 1 will 'push' the connection
+When a state argument is given it should be a positive integer. Any value
-and 0 will 'release' the connection. This is useful for example when you want to
+C<!= 0> will 'push' the connection (in general, you should specify C<1>
-let a npc control a door.
+for this) and C<0> will 'release' the connection. This is useful for
+example when you want to let an NPC control a door.
 Trigger all objects with the given connected-id by 'releasing' the connection.
+=item @playersound face-name
+Plays the given sound face (either an alias or sound file path) so that
+only the player talking to the npc can hear it.
+=item @npcsound face-name
+Plays the given sound face (either an alias or sound file path) as if
+the npc had made that sound, i.e. it will be located at the npc and all
+players near enough can hear it.
 =item @addtopic topic
 Adds the given topic names (separated by C<|>) to the list of topics
 returned.
             my @replies;
             my @match; # @match/@parse command results
             my $state = $self->{npc}{$self->{ob}->name}{dialog_state} ||= {};
             my $flag  = $self->{ob}{dialog_flag}                      ||= {};
+            my @find;
             my %vars = (
                who   => $self->{ob},
                npc   => $self->{npc},
                state => $state,
                flag  => $flag,
                msg   => $msg,
                match => \@match,
+               find  => \@find,
             );
             local $self->{ob}{record_replies} = \@replies;
             # now execute @-commands (which can result in a no-match)
                      or next topic;
                } elsif ($cmd eq "comment") {
                   # nop
+               } elsif ($cmd eq "playersound") {
+                  $self->{ob}->contr->play_sound (cf::sound::find $args);
+               } elsif ($cmd eq "npcsound") {
+                  $self->{npc}->play_sound (cf::sound::find $args);
                } elsif ($cmd eq "cond") {
                   cf::safe_eval $args, %vars
                      or next topic;
                } elsif ($cmd eq "eval") {
                   cf::safe_eval $args, %vars;
                   warn "\@eval evaluation error: $@\n" if $@;
+               } elsif ($cmd eq "check") {
+                  eval {
+                     cf::match::match $args, $self->{ob}, $self->{npc}, $self->{ob}
+                        or next topic;
+                  };
+                  warn "\@check evaluation error: $@\n" if $@;
+               } elsif ($cmd eq "find") {
+                  @find = eval {
+                     cf::match::match $args, $self->{ob}, $self->{npc}, $self->{ob}
+                  };
+                  warn "\@find evaluation error: $@\n" if $@;
                } elsif ($cmd eq "msg") {
                   push @replies, [$self->{npc}, (scalar cf::safe_eval $args, %vars)];
                } elsif ($cmd eq "setflag") {
                   my ($name, $value) = split /\s+/, $args, 2;
-                  $value ? $flag->{$name} = $value
+                  defined $value ? $flag->{$name} = $value
-                         : delete $flag->{$name};
+                                 : delete $flag->{$name};
                } elsif ($cmd eq "setstate") {
                   my ($name, $value) = split /\s+/, $args, 2;
-                  $value ? $state->{$name} = $value
+                  defined $value ? $state->{$name} = $value
-                         : delete $state->{$name};
+                                 : delete $state->{$name};
                } elsif ($cmd eq "ifflag") {
                   my ($name, $value) = split /\s+/, $args, 2;
-                  $flag->{$name} eq $value
+                  defined $value ? $flag->{$name} eq $value
+                                 : $flag->{$name}
                      or next topic;
                } elsif ($cmd eq "ifstate") {
                   my ($name, $value) = split /\s+/, $args, 2;
-                  $state->{$name} eq $value
+                  defined $value ? $state->{$name} eq $value
+                                 : $state->{$name}
                      or next topic;
                } elsif ($cmd eq "trigger") {
                   my ($con, $state) = split /\s+/, $args, 2;
-                  $con = $con * 1;
                   if (defined $state) {
-                    $self->{npc}->map->trigger ($args, $state);
+                    $self->{npc}->map->trigger ($con, $state, $self->{npc}, $self->{ob});
                   } else {
-                    my $rvalue = \$self->{npc}{dialog_trigger}{$con};
+                    my $rvalue = \$self->{npc}{dialog_trigger}{$con+0};
-                    $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue);
+                    $self->{npc}->map->trigger ($con, $$rvalue = !$$rvalue, $self->{npc}, $self->{ob});
                   }
                } elsif ($cmd eq "addtopic") {
                   push @kw, split /\|/, $args;
                   $self->{add_topic}->(split /\s*\|\s*/, $args) if $self->{add_topic};
                }
             }
             delete $self->{npc}{$self->{ob}->name}{dialog_state} unless %$state;
             delete $self->{ob}{dialog_flag}                      unless %$flag;
-            # combine lines into paragraphs
-            $reply =~ s/(?<=\S)\n(?=\w)/ /g;
-            $reply =~ s/\n\n/\n/g;
             # ignores flags and npc from replies
             $reply = join "\n", (map $_->[1], @replies), $reply;
             # now mark up all matching keywords
                      last;
                   }
                }
             }
+            $self->{npc}->use_trigger ($self->{ob})
+               if $self->{npc}->type == cf::MAGIC_EAR;
             return wantarray ? ($reply, @kw) : $reply;
          }
       }
    }

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing deliantra/server/ext/NPC_Dialogue.pm (file contents): Revision 1.3 by elmex, Wed Apr 4 11:45:16 2007 UTC vs. Revision 1.20 by root, Fri Mar 19 21:40:39 2010 UTC

Diff Legend

Comparing deliantra/server/ext/NPC_Dialogue.pm (file contents):
Revision 1.3 by elmex, Wed Apr 4 11:45:16 2007 UTC vs.
Revision 1.20 by root, Fri Mar 19 21:40:39 2010 UTC