=head1 NAME

NPC_Dialogue

=head1 DESCRIPTION

NPC dialogue support module.

=cut

package NPC_Dialogue;

use strict;

sub has_dialogue($) {
   my ($ob) = @_;

   $ob->get_message =~ /^\@match /;
}

sub parse_message($) {
   map [split /\n/, $_, 2],
      grep length,
         split /^\@match /m,
            $_[0]
}

sub new {
   my ($class, %arg) = @_;

   my $self = bless {
      %arg,
   }, $class;

   $self->{match} ||= [parse_message $self->{npc}->get_message];

   $self;
}

sub greet {
   my ($self) = @_;

   $self->tell ("hi")
}

=item ($reply, @topics) = $dialog->tell ($msg)

Tells the dialog object something and returns its response and optionally
a number of topics that are refered to by this topic.

It supports a number of command constructs. They have to follow the
C<@match> directive, and there can be multiple commands that will be
executed in order.

=over 4

=item @parse regex

Parses the message using a perl regular expression (by default
case-insensitive). Any matches will be available as C<< $match->[$index]
>>.

If the regular expression does not match, the topic is skipped.

Example:

   @match deposit
   @parse deposit (\d+) (\S+)
   @eval bank::deposit $match->[0], $match->[1]

=item @cond perl

Evaluates the given perl code. If it returns false (or causes an
exception), the topic will be skipped, otherwise topic interpretation is
resumed.

The following local variables are defined within the expression:

=over 4

=item $who - The cf::object::player object that initiated the dialogue.

=item $npc - The NPC (or magic_ear etc.) object that is being talked to.

=item $msg - The actual message as passed to this method.

=item $match - An arrayref with previous results from C<@parse>.

=back

The environment is that standard "map scripting environment", which is
limited in the type of constructs allowed (no loops, for example).

=item @eval perl

Like C<@cond>, but proceed regardless of the outcome.

=item @trigger connected-id

Trigger all objects with the given connected-id. The trigger is stateful
and retains state per connected-id.

=item @addtopic topic

Adds the given topic names (separated by C<|>) to the list of topics
returned.

=back

=cut

sub tell {
   my ($self, $msg) = @_;

   my $lcmsg = lc $msg;

   match:
   for my $match (@{ $self->{match} }) {
      for (split /\|/, $match->[0]) {
         if ($_ eq "*" || $lcmsg eq lc) {
            my $reply = $match->[1];
            my @kw;

            my @replies;
            my @match; # @match/@parse command results
            local $self->{ob}{record_replies} = \@replies;

            # now execute @-commands (which can result in a no-match)
            while ($reply =~ s/^\@(\w+)\s*([^\n]*)\n?//) {
               my ($cmd, $args) = ($1, $2);

               if ($cmd eq "parse" || $cmd eq "match") { # match is future rename
                  no re 'eval'; # default, but make sure
                  @match = $msg =~ /$args/i
                     or next match;

               } elsif ($cmd eq "cond") {
                  cf::safe_eval $args, who => $self->{ob}, npc => $self->{npc}, msg => $msg, match => \@match
                     or next match;

               } elsif ($cmd eq "eval") {
                  cf::safe_eval $args, who => $self->{ob}, npc => $self->{npc}, msg => $msg, match => \@match;
                  warn "\@eval evaluation error: $@\n" if $@;

               } elsif ($cmd eq "trigger") {
                  my $rvalue = \$self->{npc}{dialog_trigger}{$args*1};

                  my $trigger = cf::object::new "magic_ear";
                  $trigger->set_value ($$rvalue);
                  
                  # needs to be on the map for remove_button_link to work
                  # the same *should* be true for add_button_link....
                  $self->{npc}->map->insert_object ($trigger, 0, 0);

                  $trigger->add_button_link ($self->{npc}->map, $args);

                  $trigger->use_trigger;

                  $trigger->remove_button_link;
                  $trigger->remove;
                  $trigger->free;

                  $$rvalue = !$$rvalue;

               } elsif ($cmd eq "addtopic") {
                  push @kw, split /\|/, $args;

               } else {
                  warn "unknown dialogue command <$cmd,$args> used (from " . $self->{npc}->get_message . ")";
               }
            }

            # 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
            for my $match (@{ $self->{match} }) {
               for (sort { (length $b) <=> (length $a) } split /\|/, $match->[0]) {
                  if ($reply =~ /\b\Q$_\E\b/i) {
                     push @kw, $_;
                     last;
                  }
               }
            }

            return wantarray ? ($reply, @kw) : $reply;
         }
      }
   }

   ()
}

1