gde/GCE/EditAction.pm

package GCE::EditAction;

=head1 NAME

  GCE::EditActions - this is the abstraction of edit actions (placing, deleting, etc.)

=cut

use Gtk2;
use Gtk2::Gdk::Keysyms;
use Gtk2::SimpleMenu;

use Deliantra;
use Deliantra::MapWidget;

use strict;

sub new {
   my $class = shift;
   my $self = { @_ };
   bless $self, $class;
   $self->init;
   return $self;
}

sub name { } # a unique name for this tool (for storing it in a hash in the main window)

sub tool_widget { if ($_[1]) { $_[0]->{widget} = $_[1] } $_[0]->{widget} }
sub init { }

sub want_cursor { 1 }

sub only_on_click { 0 }

sub special_arrow { }

# edits one tile of the map
sub edit_one {
   my ($self, $x, $y) = @_;
   # do one edition 
}

# edits a selection
sub edit_selection {
}

# abstraction for edit_one and edit_selection ?
# takes selection if present
sub edit {
   my ($self, $map, $x, $y) = @_;
}

sub begin {
   my ($self, $map, $x, $y) = @_;
   #d# warn "CHANGE BEGIN ".(ref $self)."\n";
   $map->change_begin (ref $self);
}

sub end {
   my ($self, $map) = @_;

   #d# warn "CHANGE END ".(ref $self)."\n";
   if (my $changeset = $map->change_end) {
      splice @{ $map->{undo_stack} ||= [] },
             $map->{undo_stack_pos}++, 1e6,
             $changeset;

      #TODO: limit undo stack size to some preconfigured limit
   }
}

package GCE::EditAction::RadioModed;

our @ISA = qw/GCE::EditAction/;

sub add_mode_button {
   my ($self, $vb, $lbl, $mode, $default) = @_;

   $vb->pack_start (my $b = Gtk2::RadioButton->new ($self->{place_radio_grp}, $lbl), 0, 1, 0);
      unless (defined $self->{place_radio_grp}) {
         $self->{place_radio_grp} = $b->get_group;

         unless (defined $default) {
            $b->set_active (1);
            $self->set_mode ($mode);
         }
      }
      if ($default) {
         $b->set_active (1);
         $self->set_mode ($mode);
      }
      $b->signal_connect (clicked => sub {
            $self->set_mode ($mode);
      });
}

sub set_mode {
   my ($self, $mode) = @_;
   $self->{place_mode} = $mode;
}

sub get_mode {
   my ($self) = @_;
   $self->{place_mode}
}

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

   die "Implement me!!";

#   my $vb = new Gtk2::VBox;
#   $self->_add_mode_button ($vb, "auto",        "auto");
#   $self->_add_mode_button ($vb, "top",         "top");
#   $self->_add_mode_button ($vb, "above floor", "above");
#   $self->_add_mode_button ($vb, "below floor", "below");
#   $self->_add_mode_button ($vb, "bottom",      "bottom");
#
#   $self->{widget} = $vb;
}

package GCE::EditAction::Pick;
use GCE::ArchRef;
use GCE::Util;
use strict;

our @ISA = qw/GCE::EditAction::RadioModed/;

sub name { 'pick' }

sub want_cursor { 0 }

sub only_on_click { 1 }

sub special_arrow { 'GDK_HAND2' }

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

   my $vb = new Gtk2::VBox;
   $self->{widget} = $vb;
}

# Pick does not change the stack
sub begin {}
sub end {}

sub edit {
   my ($self, $map, $x, $y) = @_;

   my $cstack = $map->get ($x, $y);
   my ($ox, $oy) = ($x, $y);

   return unless @$cstack;

   my $arch = $cstack->[-1];
   ($x, $y, $arch, $cstack) = devirtualize ($map, $x, $y, $arch, $cstack);

   my $aref =
      GCE::ArchRef->new (
         arch => $arch,
         source => 'map',
         cb => sub {
            $map->change_begin ('attredit');
            $map->change_stack ($x, $y, $cstack);

            if (my $changeset = $map->change_end) {
               splice @{ $map->{undo_stack} ||= [] },
                      $map->{undo_stack_pos}++, 1e6,
                      $changeset;
            }
         }
      );

   $::MAINWIN->update_attr_editor ($aref);
   $::MAINWIN->update_stack_view ($map, $ox, $oy);
}

package GCE::EditAction::Perl;

use GCE::Util;
use Gtk2;
use strict;

our @ISA = qw/GCE::EditAction/;

sub name { 'perl' }

sub special_arrow { 'GDK_HEART' }

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

   my $code = (
      $::CFG->{eval_tool_code} ||= {
         'API' =>
              "# Available variables:\n"
            . "# \$x, \$y  - position in map.\n"
            . "# \$pick    - picked archetype.\n"
            . "# \$as      - stack at (\$x,\$y) in map.\n"
            . "# \$os      - archetypes of the objects in the stack at (\$x,\$y).\n",
         'unique floor' =>
             'my $i = 0; for (@$os) { $_->{is_floor} and $as->[$i]->{unique} = 1; $i++ }'
      }
   );

   my $vb = new Gtk2::VBox;
   $vb->pack_start (my $combo = Gtk2::ComboBox->new_text, 0, 1, 0);
      my $upd_combo = sub {
         my $prev_act = defined $_[0] ? $_[0] : $combo->get_active_text;
         $combo->remove_text (0)
            for ('dummy', keys %$code); # dummy in case we deleted a row
         my $pos = 0;
         my $act = 0;
         for (sort keys %$code) {
            if ($_ eq $prev_act) {
               $act = $pos;
            }
            $combo->insert_text ($pos++, $_)
         }

         $combo->set_active ($act);
      };
   $vb->pack_start (my $save_btn = Gtk2::Button->new ("delete"), 0, 1, 0);
      $save_btn->signal_connect (clicked => sub {
         delete $code->{$combo->get_active_text};
         $upd_combo->();
         $::MAINWIN->write_cfg;
      });

   $vb->pack_start (my $ed = Gtk2::Button->new ("Open Editor"), 0, 1, 0);
   $vb->pack_start (my $sw = Gtk2::ScrolledWindow->new, 1, 1, 0);
      $sw->add ($self->{txt} = Gtk2::TextView->new);
      my $get_txt = sub {
         my $buf = $self->{txt}->get_buffer;
         $buf->get_text ($buf->get_start_iter, $buf->get_end_iter, 0)
      };
   $vb->pack_start (my $hb = Gtk2::HBox->new, 0, 1, 0);
      $hb->pack_start (my $save_lbl = Gtk2::Entry->new, 1, 1, 0);
      $hb->pack_start (my $save_btn = Gtk2::Button->new ("save"), 0, 1, 0);
         $save_btn->signal_connect (clicked => sub {
            $code->{$save_lbl->get_text} = $get_txt->();
            $upd_combo->($save_lbl->get_text);
            $::MAINWIN->write_cfg;
         });

   $ed->signal_connect (clicked => sub {
      AnyEvent::EditText::edit ($get_txt->(), sub {
         my ($new, $change, $err) = @_;

         if (not defined $new) {
            quick_msg ("Error while starting editor: $err");
            return;
         }

         $self->{txt}->get_buffer->set_text ($new)
            if $change;
      });
   });

   $combo->signal_connect (changed => sub {
      my ($combo) = @_;
      my $str = $combo->get_active_text;
      $self->{txt}->get_buffer->set_text ($code->{$str});
   });

   $upd_combo->();

   $self->tool_widget ($vb);
}

sub want_cursor { 0 }

sub edit {
   my ($self, $map, $x, $y) = @_;

   my $pick = $::MAINWIN->get_pick;
   my $as = $map->get ($x, $y);

   $as = $self->eval ($map, $pick, $as, $x, $y);
   $map->change_stack ($x, $y, $as); # insert_arch_stack_layer ($as, $arch));
}

sub eval {
   my ($self, $map, $pick, $as, $x, $y) = @_;
   my $buf = $self->{txt}->get_buffer;
   my $code = $buf->get_text ($buf->get_start_iter, $buf->get_end_iter, 0);
   my $f_idx = stack_find_floor ($as, 'from_top');
   my $w_idx = stack_find_wall  ($as, 'from_top');
   my $os = [ map { $Deliantra::ARCH{$_->{_name}} } @$as ];

   unless (arch_is_floor ($as->[$f_idx])) { $f_idx = undef; }
   unless (arch_is_floor ($as->[$w_idx])) { $w_idx = undef; }

   eval $code;
   if ($@) {
      quick_msg ("There is an error in your perl code: $@", 1);
   }
   return $as;
}

package GCE::EditAction::FollowExit;
use Storable qw/dclone/;
use File::Spec::Functions;
use GCE::Util;
use Gtk2;
use strict;

our @ISA = qw/GCE::EditAction/;

sub name { 'place' }

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

   my $vb = new Gtk2::VBox;

   $self->tool_widget ($vb);
}

sub want_cursor { 0 }

sub edit {
   my ($self, $map, $x, $y, $mape) = @_;

   my $as = $map->get ($x, $y);

   my $exit;
   for my $arch (@$as) {
      my ($rx, $ry, $rarch) = devirtualize ($map, $x, $y, $arch, $as);
      if (arch_is_exit ($rarch)) {
         $exit = $rarch;
      }
   }

   if ($exit and $exit->{slaying} !~ /^!/) {
      my $dest = map2abs ($exit->{slaying}, $mape);
      my $file = $dest;
      # XXX: Replace with statusbar message
      unless (-f $file) {
         $file .= ".map";
         unless (-f $file) {
            quick_msg ($mape, "Couldn't find map file at '$dest' or '$dest.map'.", 1);
            return
         }
      }
      $::MAINWIN->open_map_editor ($file);
   }
}

package GCE::EditAction::Place;

use Storable qw/dclone/;
use GCE::Util;
use Gtk2;
use strict;

our @ISA = qw/GCE::EditAction::RadioModed/;

sub name { 'place' }

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

   my $vb = new Gtk2::VBox;

   $self->add_mode_button ($vb, "auto",        "auto");
   $self->add_mode_button ($vb, "top",         "top");
   $self->add_mode_button ($vb, "above floor", "above");
   $self->add_mode_button ($vb, "below floor", "below");
   $self->add_mode_button ($vb, "bottom",      "bottom");

   $self->tool_widget ($vb);
}

sub want_cursor { 0 }

# 1 up 2 right 4 down 8 left
my @join_ext = (
  "0",     #  0
  "1_2",   #  1
  "1_4",   #  2
  "2_2_1", #  3
  "1_1",   #  4
  "2_1_1", #  5
  "2_2_2", #  6
  "3_2",   #  7
  "1_3",   #  8
  "2_2_4", #  9
  "2_1_2", # 10
  "3_1",   # 11
  "2_2_3", # 12
  "3_4",   # 13
  "3_3",   # 14
  "4",     # 15
);

sub autojoin {
   my ($map, $pick, $x1, $y1, $x2, $y2) = @_;

   my $dx = $x2 - $x1;
   my $dy = $y2 - $y1;

   my $dir = $dy ? ($dy == -1 ? 1 : $dy == 1 ? 4 : return)
                 : ($dx == -1 ? 8 : $dx == 1 ? 2 : $dx == 0 ? 0 : return);

   my $as = $map->get ($x1, $y1);

   (my $base = $pick->{_name}) =~ s/_0$//;

   for my $idx (0 .. $#$as) {
      my $arch = $as->[$idx];
      for my $dirs (0..15) {
         my $name = $arch->{_name};

         if ($arch->{_name} eq "$base\_$join_ext[$dirs]") {
            $dirs |= $dir;

            my $name = "$base\_$join_ext[$dirs]";

            if ($Deliantra::ARCH{$name}) {
               %$arch = ( _name => $name );
               $map->change_stack ($x1, $y1, $as);

               return 1;
            }
         }
      }
   }

   return 0;
}

sub edit {
   my ($self, $map, $x, $y) = @_;

   my $pick = $::MAINWIN->get_pick;
   my $as = $map->get ($x, $y);

   my $autojoin = $pick->{_name} =~ /_0$/
                  && $self->get_mode eq "auto";

   autojoin $map, $pick, @{$self->{last_pos}}, $x, $y
      if $autojoin && $self->{last_pos};

   if (!$autojoin
       || !($self->{last_pos} ? autojoin $map, $pick, $x, $y, @{$self->{last_pos}},
                              : autojoin $map, $pick, $x, $y, $x, $y)) {
      $self->stack_action ($as, dclone $pick);
      $map->change_stack ($x, $y, $as);
      autojoin $map, $pick, $x, $y, @{$self->{last_pos}}
         if $autojoin && $self->{last_pos};
   }

   $self->{last_pos} = [$x, $y];
}

sub end {
   my ($self, $map, $x, $y, $mape) = @_;

   # now actualize stack and attr editor
   $::MAINWIN->update_stack_view ($map, $x, $y);

   my $cstack = $map->get ($x, $y);

   my $arch = $cstack->[-1];

   delete $self->{last_pos};

   # virtual... grmbl....
   # FIXME: I have to patch the stack of the real arch??? argl.. how??
   if ($arch->{_virtual}) {
      $x    = $arch->{virtual_x};
      $y    = $arch->{virtual_y};
      $arch = $arch->{_virtual};
      $cstack = $map->get ($x, $y);
   }

   $self->SUPER::end ($map, $x, $y, $mape);
}

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

   my $m = $self->get_mode;

   if ($m eq 'top') {
      push @$stack, $arch;

   } elsif ($m eq 'bottom') {
      unshift @$stack, $arch;

   } elsif ($m eq 'above') {
      my $fidx = stack_find_floor ($stack, 'from_top');

      if (defined $fidx) {
         if ($stack->[$fidx + 1]
             && $stack->[$fidx + 1]->{_name} eq $arch->{_name})
         {
            $stack->[$fidx + 1] = $arch;

         } else {
            splice (@$stack, $fidx + 1, 0, $arch);
         }

      } else {
         push @$stack, $arch;
      }

   } elsif ($m eq 'below') {
      my $fidx = stack_find_floor ($stack, 'from_bottom');

      if (defined $fidx) {
         if ($stack->[$fidx - 1]
             && $stack->[$fidx - 1]->{_name} eq $arch->{_name})
         {
            $stack->[$fidx - 1] = $arch;

         } else {
            splice (@$stack, $fidx, 0, $arch);
         }

      } else {
         unshift @$stack, $arch;
      }

   } elsif ($m eq 'auto') {
      my $fidx = stack_find_floor ($stack, 'from_top');
      my $widx = stack_find_wall  ($stack);

      if (arch_is_floor ($arch)) { # we want to place a floor tile

         if (arch_is_floor ($stack->[$fidx])) { # replace
            $stack->[$fidx] = $arch;

         } else { # insert on bottom
            unshift @$stack, $arch;
         }

      } elsif (arch_is_wall ($arch)) { # we want to place a wall

         if (arch_is_wall ($stack->[$widx])) { # replace
            $stack->[$widx] = $arch;

         } else { # insert around floor
            splice (@$stack, $fidx + 1, 0, $arch);
         }

      } else {

         if (arch_is_wall ($stack->[$widx])) {
            # if we have a wall above the floor, replace it with the to place item
            $stack->[$widx] = $arch;
            return;
         }

         if (@$stack == 0
             or not ($stack->[-1])
             or $stack->[-1]->{_name} ne $arch->{_name})
         {
            push @$stack, $arch;

         } elsif ($stack->[-1]->{_name} eq $arch->{_name}) {
            $stack->[-1] = $arch;
         }
      }
   }
}

package GCE::EditAction::Select;
use GCE::Util;
use Gtk2;
use Deliantra;
use Storable qw/dclone/;
use strict;

our @ISA = qw/GCE::EditAction::RadioModed/;

sub name { 'select' }

sub special_arrow { 'GDK_CIRCLE' }

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

   my $vb = new Gtk2::VBox;

   $vb->pack_start (my $bt = Gtk2::Button->new_with_mnemonic ("_copy"), 0, 1, 0);
      $bt->signal_connect (clicked => sub { $self->copy });
   $vb->pack_start ($self->{paste_top} = Gtk2::CheckButton->new ('paste on top'), 0, 1, 0);
   $vb->pack_start (my $bt = Gtk2::Button->new_with_mnemonic ("paste (_v)"), 0, 1, 0);
      $bt->signal_connect (clicked => sub { $self->paste });
   $vb->pack_start (Gtk2::HSeparator->new, 0, 1, 0);
   $self->add_mode_button ($vb, "place", "place");
   $self->add_mode_button ($vb, "erase", "erase");
   $self->add_mode_button ($vb, "perl", "perl");
   $vb->pack_start (my $bt = Gtk2::Button->new_with_mnemonic ("i_nvoke"), 0, 1, 0);
      $bt->signal_connect (clicked => sub { $self->invoke });

   $self->tool_widget ($vb);
}

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

   return unless $self->{selection}->{a};
   my ($x1, $y1) = @{$self->{selection}->{a}};
   my ($x2, $y2) = @{$self->{selection}->{b}};

   if ($x1 > $x2) { ($x2, $x1) = ($x1, $x2) }
   if ($y1 > $y2) { ($y2, $y1) = ($y1, $y2) }

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

   $self->{copy_coords} = [$x1, $y1, $x2, $y2];
   $self->{copy};
   for (my $x = $x1; $x <= $x2; $x++) {
      for (my $y = $y1; $y <= $y2; $y++) {
         $self->{copy}->[$x - $x1]->[$y - $y1] = $map->get ($x, $y);
      }
   }
}

sub paste {
   my ($self, $map, $xp, $yp) = @_;

   return unless $self->{selection}->{a};

   my ($x1, $y1);

   if (defined $xp) {
       ($x1, $y1) = ($xp, $yp);
   } else {
       ($x1, $y1) = @{$self->{selection}->{a}};
   }

   $map ||= $self->{selection}->{map};

   my $p_o_top = $self->{paste_top}->get_active * 1;

   my $w = $self->{copy_coords}->[2] - $self->{copy_coords}->[0];
   my $h = $self->{copy_coords}->[3] - $self->{copy_coords}->[1];
   $self->{copy};
   $self->SUPER::begin ($map, $x1, $y1);
   for (my $x = $x1; $x <= ($x1 + $w); $x++) {
      for (my $y = $y1; $y <= ($y1 + $h); $y++) {
         my $cstck = $map->get ($x, $y);

         if ($p_o_top) {
            push @$cstck, @{dclone ($self->{copy}->[$x - $x1]->[$y - $y1] || [])};
            $map->change_stack ($x, $y, $cstck);
         } else {
            $map->change_stack ($x, $y, dclone ($self->{copy}->[$x - $x1]->[$y - $y1] || []));
         }
      }
   }
   $self->SUPER::end ($map);
   $map->invalidate_all;
}

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

   return unless $self->{selection}->{a};
   my ($x1, $y1) = @{$self->{selection}->{a}};
   my ($x2, $y2) = @{$self->{selection}->{b}};

   if ($x1 > $x2) { ($x2, $x1) = ($x1, $x2) }
   if ($y1 > $y2) { ($y2, $y1) = ($y1, $y2) }

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

   my $m = $self->get_mode;
   $self->SUPER::begin ($map, $x1, $y1);
   for (my $x = $x1; $x <= $x2; $x++) {
      for (my $y = $y1; $y <= $y2; $y++) {
         if ($m eq 'place') {
            $::MAINWIN->{edit_collection}{place}->edit ($map, $x, $y);
         } elsif ($m eq 'erase') {
            $::MAINWIN->{edit_collection}{erase}->edit ($map, $x, $y);
         } elsif ($m eq 'perl') {
            $::MAINWIN->{edit_collection}{perl}->edit ($map, $x, $y);
         }
      }
   }
   $self->SUPER::end ($map);
}

sub want_cursor { 0 }

sub begin {
   my ($self, $map, $x, $y) = @_;

   if ($self->{selection}->{map}) {
      $self->{selection}->{map}->overlay ('selection');
   }
   delete $self->{selection};

   $self->{selection}->{a} = [$x, $y];
}

sub end {
}

sub edit {
   my ($self, $map, $x, $y) = @_;

   $self->{selection}->{b} = [$x, $y];
   $self->{selection}->{map} = $map;
   $self->update_overlay ();
}

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

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

   return unless (defined $self->{selection}->{a} and defined $self->{selection}->{b});

   my ($x1, $y1) = @{$self->{selection}->{a}};
   my ($x2, $y2) = @{$self->{selection}->{b}};

   if ($x1 > $x2) { ($x2, $x1) = ($x1, $x2) }
   if ($y1 > $y2) { ($y2, $y1) = ($y1, $y2) }

   my $w = ($x2 - $x1) + 1;
   my $h = ($y2 - $y1) + 1;

   $map->overlay (selection =>
      $x1 * TILESIZE, $y1 * TILESIZE,
      $w  * TILESIZE, $h  * TILESIZE,
      sub {
         my ($self, $x, $y) = @_;
         $self->{window}->draw_rectangle (
            $_ & 1 ? $self->style->black_gc : $self->style->white_gc,
            0,
            $x + $_, $y + $_,
            ($w * TILESIZE) - 1 - $_ * 2,
            ($h * TILESIZE) - 1 - $_ * 2
         ) for 0..3;
      }
   );
}

package GCE::EditAction::Erase;
use GCE::Util;
use Gtk2;
use strict;

our @ISA = qw/GCE::EditAction::RadioModed/;

sub name { 'erase' }

sub want_cursor { 0 }

sub special_arrow { 'GDK_DIAMOND_CROSS' }

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

   my $vb = new Gtk2::VBox;
   $self->add_mode_button ($vb, "top",         "top");
   $self->add_mode_button ($vb, "walls",       "walls");
   $self->add_mode_button ($vb, "above floor", "above", 'default');
   $self->add_mode_button ($vb, "floor",       "floor");
   $self->add_mode_button ($vb, "below floor", "below");
   $self->add_mode_button ($vb, "bottom",      "bottom");
   $self->add_mode_button ($vb, "pick match",  "match");

   $self->tool_widget ($vb);

   $vb->pack_start ($self->{no_wall_check} = Gtk2::CheckButton->new ("protect walls"), 0, 1, 0);
   $vb->pack_start ($self->{no_monsters_check} = Gtk2::CheckButton->new ("protect monsters"), 0, 1, 0);
}

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

   my $r = ($self->{no_wall_check}->get_active     && arch_is_wall ($arch))
           || ($self->{no_monsters_check}->get_active && arch_is_monster ($arch));

   return $r;
}

sub edit {
   my ($self, $map, $x, $y) = @_;

   my $as = $map->get ($x, $y);
   $self->stack_action ($as);
   $map->change_stack ($x, $y, $as);
}

sub stack_action {
   my ($self, $stack) = @_;

   my $m = $self->get_mode;

   if ($m eq 'top') {
      pop @$stack;

   } elsif ($m eq 'bottom') {
      shift @$stack;

   } elsif ($m eq 'above') {
      my $fidx = stack_find_floor ($stack, 'from_top');

      if (arch_is_floor ($stack->[$fidx]) and $stack->[$fidx + 1]) {
         splice (@$stack, $fidx + 1, 1)
            unless $self->check_excluded ($stack->[$fidx + 1])

      } elsif (not arch_is_floor ($stack->[$fidx])) {
         splice (@$stack, $fidx, 1)
            unless $self->check_excluded ($stack->[$fidx])

      }

   } elsif ($m eq 'below') {
      my $fidx = stack_find_floor ($stack, 'from_bottom');

      if ($fidx > 0 and not arch_is_floor ($stack->[$fidx - 1])) {
         splice (@$stack, $fidx - 1, 1) 
            unless $self->check_excluded ($stack->[$fidx - 1])

      } elsif (not arch_is_floor ($stack->[$fidx])) { # no floor found
         splice (@$stack, $fidx, 1)
            unless $self->check_excluded ($stack->[$fidx])

      }

   } elsif ($m eq 'walls') {
      my $widx = stack_find_wall ($stack, 'from_top');

      while (arch_is_wall ($stack->[$widx])) {
         splice (@$stack, $widx, 1);
         $widx = stack_find_wall ($stack, 'from_top')
      }

   } elsif ($m eq 'floor') {
      my $fidx = stack_find_floor ($stack, 'from_top');

      while (arch_is_floor ($stack->[$fidx])) {
         splice (@$stack, $fidx, 1);
         $fidx = stack_find_floor ($stack, 'from_top')
      }

   } elsif ($m eq 'match') {
      my $pick_name = $::MAINWIN->get_pick ()->{_name};
      my $idx = stack_find ($stack, 'from_top', sub { $_[0]->{_name} eq $pick_name });

      while ($stack->[$idx] and $stack->[$idx]->{_name} eq $pick_name) {
         splice (@$stack, $idx, 1);
         $idx = stack_find ($stack, 'from_top', sub { $_[0]->{_name} eq $pick_name });
      }
   }
}

package GCE::EditAction::Connect;
use Storable qw/dclone/;
use GCE::Util;
use Gtk2;
use File::Spec::Functions;
use strict;

our @ISA = qw/GCE::EditAction::RadioModed/;

sub name { 'connect' }

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

   my $vb = new Gtk2::VBox;
   #not supported anymore: $self->add_mode_button ($vb, "auto", "auto", 1);
   $self->add_mode_button ($vb, "exit", "exit");
   $self->add_mode_button ($vb, "exit (no path)", "exit_no_slay");
   $self->add_mode_button ($vb, "connect", "connect");

   $vb->pack_start (my $l = Gtk2::Label->new, 0, 0, 0);
   $l->set_text ("connection:");
   $vb->pack_start ($self->{pcon} = Gtk2::SpinButton->new_with_range (1, 10000, 1), 0, 1, 0);
   $vb->pack_start ($self->{sel_lbl} = Gtk2::Label->new, 0, 0, 0);
   $self->tool_widget ($vb);
}

sub want_cursor { 0 }

#XXX: change_begin/end is handled in edit
sub begin { }
sub end { }

sub edit {
   my ($self, $map, $x, $y, $mapedit) = @_;

   my $pick = $::MAINWIN->get_pick;
   my $as = $map->get ($x, $y);

   my $mode = $self->get_mode;

   my $exit;
   my $conns = [];
   for (@$as) {
      if ($_->{_virtual}) {
         # FIXME: implement virtual handling for connect, for now ignore
         next;
      }
      if (arch_is_connector ($_)) {
         push @$conns, $_;
      }
      if (arch_is_exit ($_)) {
         $exit = $_;
      }
   }

   if ($mode =~ /^exit/) {
      $conns = [];

      if ($self->{sel_pos}) {
         my $pos = delete $self->{sel_pos};

         my ($path1, $path2);
         unless ($mode eq 'exit_no_slay') {
            ($path1, $path2) =
               exit_paths ($::MAPDIR, $pos->{path}, $mapedit->{path});
         }

         if ($pos->{exit}) {
            $pos->{exit}->{hp} = $x;
            $pos->{exit}->{sp} = $y;
            $pos->{exit}->{slaying} = $path2
               if $path2 ne '';
         }

         if ($exit) {
            $exit->{hp} = $pos->{x};
            $exit->{sp} = $pos->{y};
            $exit->{slaying} = $path1
               if $path1 ne '';
         }

         $self->SUPER::begin ($map, $x, $y, $mapedit);
         $map->change_stack ($x, $y, $as);
         $self->SUPER::end ($map);
         $self->SUPER::begin ($pos->{map}, $pos->{x}, $pos->{y});
         $pos->{map}->change_stack ($pos->{x}, $pos->{y}, $pos->{stack});
         $self->SUPER::end ($pos->{map});

         #bothers schmorp: quick_msg ($mapedit, "$exit->{slaying} ($exit->{hp}:$exit->{sp}) $exit->{_name} <=> $exit2->{slaying} ($exit2->{hp}:$exit2->{sp}) $exit2->{_name}", 0);

         $::MAINWIN->{edit_collection}{pick}->edit ($map, $x, $y);

         delete $self->{sel_pos};
         $self->{sel_lbl}->set_text ('');
      } else {
         my $pth = substr $mapedit->{path}, -10;
         $self->{sel_lbl}->set_text ("src: ($x:$y) $pth");
         $self->{sel_pos} = {
            x     => $x,
            y     => $y,
            path  => $mapedit->{path},
            stack => $as,
            map   => $map,
            exit  => $exit
         };
      }
   } elsif ($mode eq 'connect') {
      for (@$conns) {
         $_->{connected} = $self->{pcon}->get_value;
      }
      $self->SUPER::begin ($map, $x, $y, $mapedit);
      $map->change_stack ($x, $y, $as);
      $self->SUPER::end ($map);
   }
}

=head1 AUTHOR

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

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

=cut

1

Revision:	1.57
Committed:	Thu Apr 22 15:02:06 2010 UTC (14 years, 1 month ago) by elmex
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.56:	+40 -55 lines
Log Message:	fixed connect tool.