package GCE::ArchRef;
=head1 NAME

   GCE::ArchRef - a intelligent reference to an arch instance on/in the map

=head1 SYNOPSIS

   GCE::ArchRef->new (arch => <hashref>, cb => <changecb>)

=over 4

=cut

use Storable qw/dclone/;
use Deliantra;
use Carp;
use GCE::Util;

sub getarch {
   my ($ar) = @_;

   if (ref $ar eq 'GCE::ArchRef') {
      return $ar->{arch}
   } else {
      return $ar
   }
}

sub new {
   my $class = shift;
   my $self = { @_ };
   bless $self, $class;

   unless (defined $self->{arch}) {
      Carp::confess ("arch not defined when making new ArchRef")
   }
   unless (defined $Deliantra::ARCH{$self->getarch->{_name}}) {
      quick_msg (
         $::MAINWIN,
         "ERROR: No such archetype '" . ($self->getarch->{_name})
         ."' replacing it's type with 'empty_archetype'.",
         0
      );
   }

   return $self;
}

sub type {
   my ($self) = @_;
   Deliantra::arch_attr $self->getarch;
}

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

   $Deliantra::ARCH{$self->getarch->{_name}} || $Deliantra::ARCH{empty_archetype};
}

sub picker_folder {
   my ($self) = @_;
   my $folder = $self->archetype->{editor_folder};
   my @a = split /\//, $folder;
   $a[0]
}

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

   my $name = $self->get ('_name');
   my $rname = $self->get ('name');
   my $t = $self->type;

   $name . ($rname ? " - $rname" : "") . " ($t->{name})"
}

sub field_value_is_default {
   my ($self, $key, $val) = @_;
   my $al_arch = $self->archetype;

   # XXX: Was '... and $val', does this fix problems?
   (defined ($al_arch->{$key}) && $al_arch->{$key} ne $val)
      || (not (defined $al_arch->{$key}) and $val)
}

sub add_inv {
   my ($self, $arch) = @_;
   push @{$self->{arch}->{inventory}}, dclone (getarch $arch);

   $self->{cb}->($self)
      if defined $self->{cb};

   $self->exec_change_cbs (qw/inventory/);
}

sub swap_inv {
   my ($self, $swapidx, $ownidx) = @_;
   my $inv = $self->getarch->{inventory};

   ($inv->[$swapidx], $inv->[$ownidx])
      = ($inv->[$ownidx], $inv->[$swapidx]);

   $self->{cb}->($self)
      if defined $self->{cb};

   $self->exec_change_cbs (qw/inventory/);
}

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

   my $cb = sub {
      $self->{cb}->($self)
         if defined $self->{cb};

      $self->exec_change_cbs (qw/inventory/);
   };

   [ map { GCE::ArchRef->new (arch => $_, source => 'inventory', cb => $cb) } @{$self->get ('inventory') || []} ]
}

sub replace_inv {
   my ($self, $idx, $new) = @_;
   splice @{$self->getarch->{'inventory'}}, $idx, 1, $new;

   $self->{cb}->($self)
      if defined $self->{cb};

   $self->exec_change_cbs (qw/inventory/);
}

sub remove_inv {
   my ($self, $idx) = @_;
   splice @{$self->getarch->{'inventory'}}, $idx, 1;

   $self->{cb}->($self)
      if defined $self->{cb};

   $self->exec_change_cbs (qw/inventory/);
}

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

   my $arch = $self->getarch;
   for (keys %$arch) {
      delete $arch->{$_} if $_ ne '_name'
   }

   $self->{cb}->($self)
      if defined $self->{cb};

   $self->exec_change_cbs;
}

sub get {
   my ($self, $key) = @_;
   $self->getarch->{$key}
}

sub get_or_default {
   my ($self, $key) = @_;
   def ($self->get ($key), $self->archetype->{$key})
}

sub set_silent {
   my ($self, $key, $value, $type) = @_;

   my $arch = $self->getarch;
   my $al_arch = $self->archetype;

   if (ref $value) {
      $arch->{$key} = $value;

   } elsif (not defined $value) {
      # this is introduced so that move types are correctly handled.
      # but it also makes incredible sense to me to delete attributes with
      # undef values!
      delete $arch->{$key};

   } else {
      if (not defined $al_arch->{$key}) {
         if ((not defined $value) || $value eq ''
             || ($type eq 'bool' && $value eq '0')) {
            # try to normalize
            delete $arch->{$key};
         } else {
            # try to normalize
            $arch->{$key} = $value;
         }
      } else {
         if ($al_arch->{$key} ne $value) {
            $arch->{$key} = $value;
         } else {
            # try to normalize
            delete $arch->{$key};
         }
      }
   }

   $self->{cb}->($arch)
      if defined $self->{cb};
}

sub set {
   my ($self, $key, $value, $type) = @_;
   $self->set_silent ($key, $value, $type);

   $self->exec_change_cbs ($key);
}

sub remove_on_change {
   my ($self, $key) = @_;
   delete $self->{change_cbs}->{$key};
}

sub add_on_change {
   my ($self, $key, $cb) = @_;
   $self->{change_cbs}->{$key} = $cb;
}

sub exec_change_cbs {
   my ($self, @a) = @_;
   $_->($self, @a) for (values %{$self->{change_cbs}});
}

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

 Robin Redeker <elmex@ta-sa.org>
 http://www.ta-sa.org/

=cut
1;