#! perl

=head1 CF+ map maker library and utilities

=over 4

=cut
# This extension loads some nice functionality for map makers

sub rec_inv_by_slaying {
   my ($ob, $slaying, $cb) = @_;
   $cb->($ob) if $ob->slaying eq $slaying;
   for my $iob ($ob->inv) { rec_inv_by_slaying ($iob, $slaying, $cb) }
}

=item count_linked ($map, $connected)

Counts the number of objects with the connected value C<$connected> on
the map C<$map>.

=cut

sub count_linked {
   my ($map, $connected) = @_;
   my (@a) = $map->find_link ($connected);
   scalar @a
}

=item object attachment: 'check_inventory_on_apply'

This attachment checks on apply whether the applyer
has a specific item. Currently you can only match the slaying
field of the inventory item of the player.

On match the apply isn't inhibited.

Following configuration can be supplied to this attachment:

=over 4

=item key_string

This is the string that will be matched against the slaying field
of the inventory item of the player. The first found item will be
decreased by the amount that can be passed in the 'decrease_by_cnt'
option.

=item decrease_by_cnt

This is the amount the matching object will be decreased by from the inventory.
Default is 0 and means nothing will be removed.

=item message_on_match

This is the message that will printed to the player if a matching
object was found.

=item message_on_nomatch

This is the message that will printed to the player if NO matching
object was found.

=back

=cut

cf::object::attachment check_inventory_on_apply =>
   on_apply => sub {
      my ($self, $pl) = @_;
      my $cfg = $self->{check_inventory_on_apply};
      my $match;
      rec_inv_by_slaying ($pl, $cfg->{key_string}, sub {
         my ($ob) = @_;
         $match = $ob;
      });
      if ($match) {
         $match->decrease ($cfg->{decrease_by_cnt}) if $cfg->{decrease_by_cnt};
         $pl->message ($cfg->{message_on_match}, cf::NDI_UNIQUE) if defined $cfg->{message_on_match};
      } else {
         $pl->message ($cfg->{message_on_nomatch}, cf::NDI_RED | cf::NDI_UNIQUE) if defined $cfg->{message_on_nomatch};
         cf::override;
      }
   };


=item object attachment: 'trigger_on_dialog_flag'

This attachment checks whether the player has a specific
dialog flag set (the ones you can set with @setflag, see also
L<NPC_Dialogue>, and triggers a connection depending on that.

The attachment has following configuration:

=over 4

=item flag

This field should contain the name of the flag that you want to check
for.

=item connection

The connection ID of the connection you want to trigger.

=item state

The state of the connection: 0 for release, 1 for push.

=back

=cut

cf::object::attachment trigger_on_dialog_flag =>
   on_move_trigger => sub {
      my ($self, $who, $orig) = @_;
      my $cfg = $self->{trigger_on_dialog_flag};
      if (exists $who->{ob}{dialog_flag}{$cfg->{flag}}) {
         if ($who->{ob}{dialog_flag}{$cfg->{flag}}) {
            $self->map->trigger ($cfg->{connection}, $cfg->{state});
         }
         cf::override;
      }
   };


=item object attachment: 'ratelimit_converter'

This is an attachment that allows a converter to be ratelimited in terms of
items per hour.

The attachment has following configuration:

=over 4

=item match

This field should contain a L<cf::match> match string, that should match the
input object.

=item generate_arch

This field should contain the archetype name of the output.

=item items_per_hour

This field should contain the number of items to generate at maximum per hour.
Default is: 20

=item converter_tag

This is the tag of the converter, it should be unique per converter. You can
also use this to make the limit hit for multiple converters.

=item msg

This is the message when the player successfully converted.

=item failmsg

This is the failure message, which will be presented to the player when he hits
the rate limit.

=back

=cut

cf::object::attachment ratelimit_converter =>
   on_drop_on => sub {
      my ($self, $obj, $who) = @_;

      my $cfg = $self->{ratelimit_converter};

      my $output_arch = $cfg->{generate_arch};
      my $match  = $cfg->{match};
      my $mitems = $cfg->{items_per_hour} || 20;
      my $tag    = 'ratelimit_converter_' . $cfg->{converter_tag};

      return unless cf::match::match $match, $obj;

      my $items = $mitems;

      if (!$who->flag (cf::FLAG_WIZ) && defined $who->{$tag . '_ts'}) {
         my $itemtime = time - $who->{$tag . '_ts'};
         if ($itemtime < 3600) {
            $items = int ($items * ($itemtime / 3600));
         }
      }

      my $nr = $obj->nrof ? $obj->nrof : 1;
      $nr = $items if $nr > $items;

      if ($nr > 0) {
         $obj->decrease ($nr);

         my $out = cf::object::generate ($output_arch, $self);
         $out->nrof ($nr);
         $out->insert_at ($self, $self);

         if ($nr >= $mitems) {
            $who->{$tag . '_ts'} = time;
         } else {
            # give player credit for the unused refills.
            $who->{$tag . '_ts'} =
               time - int ((($items - $nr) * 3600) / $mitems);
         }

         $who->message ($cfg->{msg})
            if $cfg->{msg} ne '';
      } else {
         if ($who->contr) {
            $who->contr->failmsg ($cfg->{failmsg})
               if $cfg->{failmsg} ne '';
         }
      }

      if ($who->flag (cf::FLAG_WIZ)) {
         delete $who->{$tag . '_ts'};
      }
   };


=item object attachment: 'display_info_window'

If you attach this attachment to a sign a window containing the
message will open in the client when the player applies it.

Use this feature with care, as popups usually are very noisy.
This is mostly thought for tutorial or other instructions.

=cut

cf::object::attachment display_info_window =>
   on_apply => sub {
      my ($self, $pl) = @_;

      return unless $pl->contr->ns->{can_widget};

      my $cfg = $self->{display_info_window};

      if ($pl->contr->ns->{info_wins}->{$self->uuid}) {
         $pl->contr->ns->{info_wins}->{$self->uuid}->destroy;
      }

      my $ws = $pl->contr->ns->new_widgetset;

      my $w = $ws->{my_main} = $ws->new (Toplevel =>
         force_w => 600,
         force_h => 400,
         x => 'center',
         y => 'center',
         title => 'Information Sign',
         has_close_button => 1,
         on_delete => sub { $ws->destroy },
      );
      $w->add ($ws->{txt_area} = $ws->new ('TextScroller'));
      $ws->{txt_area}->add_paragraph ($self->msg);
      $w->show;
      $pl->contr->ns->{info_wins}->{$self->uuid} = $ws;

      cf::override 1;
   };

=back

=cut