package GCE::StackRef;
use strict;
=head1 NAME

   GCE::StackRef - a intelligent reference to a mapspace or inventory (arch stack)

=head1 SYNOPSIS

   GCE::StackRef->new (...);

=over 4

=cut

use Scalar::Util qw/weaken/;
use Storable qw/dclone/;
use Deliantra;
use Carp;
use GCE::Util;
use base qw/Object::Event/;

sub new {
   my $class = shift;
   my $self = { cursors => [], @_ };

   $self->{src} ||= [];

   if (@{$self->{src}} == 3) {
      return GCE::StackRef::Map->_new ($self);
   } elsif (@{$self->{src}} == 2) {
      return GCE::StackRef::Arch->_new ($self);
   } else {
      return GCE::StackRef::Dummy->_new ($self);
   }

   bless $self, $class;

   return $self;
}

sub _new {
   my $class = shift;
   my $self = shift;
   bless $self, $class;

   $self->init_object_events;

   $self->init;
   $self
}

sub cursor {
   my ($self, $z) = @_;
   my $c =
      ($self->{cursors}->[$z]
         ||= GCE::StackRef->new (src => [$self, $z]));
   weaken $self->{cursors}->[$z];
   $c
}

sub cursor_change {
   my ($self, $z, $msg, $inval) = @_;
   $self->{cursors}->[$z]->changed ($msg, $inval)
      if defined $self->{cursors}->[$z];

   $self->{cursors}->[$z] = undef if $inval;
}

sub changed : event_cb {
   my ($self, $msg, $invalidated) = @_;

   warn "$self (@{$self->{src}}) owner $self->{owner}"
        . " changed: $msg, invalid? ($invalidated)\n";
   if ($invalidated) {
      $_->changed ($msg, $invalidated)
         for grep { defined $_ } @{$self->{cursors}};

      delete $self->{src};
      delete $self->{ref};
      delete $self->{map};
   }
}

sub overlay {
   my ($self) = @_;
}

package GCE::StackRef::Dummy;
use Storable qw/dclone/;

use base qw/GCE::StackRef/;

sub init {
   my ($self) = @_;
}

sub push {
   my ($self, $arch) = @_;
   $self->commit ('push_dummy');
}

sub swap {
   my ($self, $swapidx, $ownidx) = @_;
   $self->commit ('swap_dummy');
}

sub replace {
   my ($self, $idx, $new) = @_;
   $self->cursor_change ($idx, 'replace_dummy');
   $self->commit ('replace_dummy');
}

sub remove {
   my ($self, $idx) = @_;
   $self->cursor_change ($idx, 'remove_dummy');
   $self->commit ('remove_dummy');
}

sub commit {
   my ($self, $change) = @_;
   $self->changed ($self->{owner} . '#' . $change);
}

sub size {
   0
}

sub get {
   my $self = shift;
   my $z = shift;

   return () unless defined $z;

   $self->{template}
      ? dclone ($self->{template})
      : { _name => 'empty_archetype' }
}

package GCE::StackRef::Map;
use GCE::Util;
use Deliantra;
use Deliantra::MapWidget;

use base qw/GCE::StackRef/;

sub init {
   my ($self) = @_;
   $self->{map} = $self->{src}->[0];
   $self->{x}   = $self->{src}->[1];
   $self->{y}   = $self->{src}->[2];
   $self->{ms}  = $self->{map}->{map}->get ($self->{x}, $self->{y});
}

sub overlay {
   my ($self) = @_;
   # XXX: Fixme! there is still a bug in removing overlays!!
   $self->update_cursor_overlay ('stack_view');
}

sub push {
   my ($self, $arch) = @_;

   push @{$self->{ms}}, dclone ($arch->getarch);

   $self->commit ('push_ms');
}

sub swap {
   my ($self, $swapidx, $ownidx) = @_;

   my $ms = $self->{ms};

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

   $self->cursor_change ($swapidx, 'swap_ms');
   $self->cursor_change ($ownidx, 'swap_ms');

   $self->commit ('swap_ms');
}

sub replace {
   my ($self, $idx, $new) = @_;

   splice @{$self->{'ms'}}, $idx, 1, $new;
   $self->cursor_change ($idx, 'replace_ms');

   $self->commit ('replace_ms');
}

sub remove {
   my ($self, $idx) = @_;

   splice @{$self->{ms}}, $idx, 1;
   $self->cursor_change ($idx, 'remove_ms');

   $self->commit ('remove_ms');
}

sub commit {
   my ($self, $change) = @_;

   $change = 'unknown_edit' unless defined $change;
   $change = $self->{owner} . '#' . $change;

   my $map = $self->{map};
   $map = $map->{map};

   $map->change_begin ($change . ' on ' . $self);

   $map->change_stack ($self->{x}, $self->{y}, $self->{ms});

   if (my $changeset = $map->change_end) {
      my $undo_stack = ($map->{undo_stack} ||= []);

      my $str_self = "$self";

      if ($map->{undo_stack_pos} > 0 
          && $undo_stack->[$map->{undo_stack_pos} - 1]->{title}
             =~ /^attribute_edit:.*? on \Q$str_self\E$/) {
         $map->{undo_stack_pos}--;

         warn "merged change ($changeset->{title})\n";
      } else {
         warn "added change ($changeset->{title})\n";
      }

      splice @{ $map->{undo_stack} ||= [] },
             $map->{undo_stack_pos}++, 1e6,
             $changeset;
   }
   $self->{ms} = $self->{map}->{map}->get ($self->{x}, $self->{y});

   $::MAINWIN->broadcast_cursor_changes ($self->{map}, $self->{x}, $self->{y});

   $self->changed ($change);
}

sub size {
   @{$_[0]->{ms} || []}
}

sub get {
   my ($self, $z) = @_;

   if (defined $z) {
      return undef unless @{$self->{ms}};
      return $self->{ms}->[$z]
   } else {
      return @{$self->{ms} || []}
   }
}

sub update_cursor_overlay {
   my ($self, $owner) = @_;

   $self->{map}->{map}->{overlay_holder}->{$owner} = "$self";

   $self->{map}->{map}->overlay ('srovl_' . $owner =>
      $self->{x} * TILESIZE,
      $self->{y} * TILESIZE,
      TILESIZE,
      TILESIZE,
      sub {
         my ($self, $x, $y) = @_;

         if (!$self->{_conn_upd_curs_gc_fg}->{$owner}) {
            my $gc
               = $self->{_conn_upd_curs_gc_fg}->{$owner}
               = Gtk2::Gdk::GC->new ($self->{window});
            my $cm = $self->{window}->get_colormap;
            $gc->set_foreground (
               gtk2_get_color (
                  $self, $owner eq 'stack_view' ? "green" : "blue"));
            $gc->set_background (gtk2_get_color ($self, "black"));
         }

         $self->{window}->draw_rectangle (
            $self->{_conn_upd_curs_gc_fg}->{$owner},
            0,
            $x + ($owner eq 'stack_view' ? 1 : 0),
            $y + ($owner eq 'stack_view' ? 1 : 0),
            TILESIZE - ($owner eq 'stack_view' ? 3 : 1),
            TILESIZE - ($owner eq 'stack_view' ? 3 : 1),
         );
      }
   );
}

sub DESTROY {
   my ($self) = @_;
   if ($self->{map}->{map}->{overlay_holder}->{'stack_view'} eq "$self") {
      $self->{map}->{map}->overlay ('srovl_stack_view')
   }
   warn "$self StackRef::Map DESTROYED!\n";
}

package GCE::StackRef::Arch;

use Carp;
use GCE::Util;
use base qw/GCE::StackRef/;

sub init {
   my ($self) = @_;
   $self->{ref}  = $self->{src}->[0];
   $self->{z}    = $self->{src}->[1];
}

sub get {
   my ($self, $z) = @_;
   my $a = $self->{ref}->get ($self->{z});
   $a = $a->{inventory}->[$z] if defined $z;
   unless (defined $a) {
      Carp::confess "GOT UNDEF ARCH IN ARCHREF $self->{ref}, $self->{z}, $z!";
   }
   $a
}

sub push {
   my ($self, $arch) = @_;

   my $a = $self->get;
   push @{$a->{inventory}}, $arch;
   $self->commit ('push_inv');
}

sub swap {
   my ($self, $swapidx, $ownidx) = @_;

   my $a = $self->get;
   my $inv = $a->{inventory};
   ($inv->[$swapidx], $inv->[$ownidx])
      = ($inv->[$ownidx], $inv->[$swapidx]);
   $self->commit ('swap_inv');
}

sub replace {
   my ($self, $idx, $new) = @_;

   my $a = $self->get;
   splice @{$a->{inventory}}, $idx, 1, $new;
   $self->cursor_change ($idx, 'replace_inv');
   $self->commit ('replace_inv');
}

sub remove {
   my ($self, $idx) = @_;

   my $a = $self->get;
   splice @{$a->{inventory}}, $idx, 1;
   $self->cursor_change ($idx, 'remove_inv', 1);

   $self->commit ('remove_inv');
}

sub commit {
   my ($self, $msg) = @_;
   $self->{ref}->commit ($msg);
   $self->changed ($self->{owner} . '#' . $msg);
}

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

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

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

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

   $Deliantra::ARCH{$self->get->{_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->attr ('_name');
   my $rname = $self->attr ('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 reset_to_defaults {
   my ($self) = @_;

   my $arch = $self->get;

   for (keys %$arch) {
      delete $arch->{$_} if $_ ne '_name'
   }

   $self->commit ('reset_to_defaults');
}

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

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

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

   } 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->commit ($src . '!attribute_edit:' . $key);
}

=head1 AUTHOR

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

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

=cut
1;