ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/gde/GCE/EditAction.pm
Revision: 1.51
Committed: Thu Dec 27 22:28:01 2007 UTC (16 years, 5 months ago) by root
Branch: MAIN
CVS Tags: pre_cursor_branch
Branch point for: cursor
Changes since 1.50: +5 -5 lines
Log Message:
upgrade Crossfire to Deliantra

File Contents

# Content
1 package GCE::EditAction;
2
3 =head1 NAME
4
5 GCE::EditActions - this is the abstraction of edit actions (placing, deleting, etc.)
6
7 =cut
8
9 use Gtk2;
10 use Gtk2::Gdk::Keysyms;
11 use Gtk2::SimpleMenu;
12
13 use Deliantra;
14 use Deliantra::MapWidget;
15
16 use strict;
17
18 sub new {
19 my $class = shift;
20 my $self = { @_ };
21 bless $self, $class;
22 $self->init;
23 return $self;
24 }
25
26 sub name { } # a unique name for this tool (for storing it in a hash in the main window)
27
28 sub tool_widget { if ($_[1]) { $_[0]->{widget} = $_[1] } $_[0]->{widget} }
29 sub init { }
30
31 sub want_cursor { 1 }
32
33 sub only_on_click { 0 }
34
35 sub special_arrow { }
36
37 # edits one tile of the map
38 sub edit_one {
39 my ($self, $x, $y) = @_;
40 # do one edition
41 }
42
43 # edits a selection
44 sub edit_selection {
45 }
46
47 # abstraction for edit_one and edit_selection ?
48 # takes selection if present
49 sub edit {
50 my ($self, $map, $x, $y) = @_;
51 }
52
53 sub begin {
54 my ($self, $map, $x, $y) = @_;
55 #d# warn "CHANGE BEGIN ".(ref $self)."\n";
56 $map->change_begin (ref $self);
57 }
58
59 sub end {
60 my ($self, $map) = @_;
61
62 #d# warn "CHANGE END ".(ref $self)."\n";
63 if (my $changeset = $map->change_end) {
64 splice @{ $map->{undo_stack} ||= [] },
65 $map->{undo_stack_pos}++, 1e6,
66 $changeset;
67
68 #TODO: limit undo stack size to some preconfigured limit
69 }
70 }
71
72 package GCE::EditAction::RadioModed;
73
74 our @ISA = qw/GCE::EditAction/;
75
76 sub add_mode_button {
77 my ($self, $vb, $lbl, $mode, $default) = @_;
78
79 $vb->pack_start (my $b = Gtk2::RadioButton->new ($self->{place_radio_grp}, $lbl), 0, 1, 0);
80 unless (defined $self->{place_radio_grp}) {
81 $self->{place_radio_grp} = $b->get_group;
82
83 unless (defined $default) {
84 $b->set_active (1);
85 $self->set_mode ($mode);
86 }
87 }
88 if ($default) {
89 $b->set_active (1);
90 $self->set_mode ($mode);
91 }
92 $b->signal_connect (clicked => sub {
93 $self->set_mode ($mode);
94 });
95 }
96
97 sub set_mode {
98 my ($self, $mode) = @_;
99 $self->{place_mode} = $mode;
100 }
101
102 sub get_mode {
103 my ($self) = @_;
104 $self->{place_mode}
105 }
106
107 sub init {
108 my ($self) = @_;
109
110 die "Implement me!!";
111
112 # my $vb = new Gtk2::VBox;
113 # $self->_add_mode_button ($vb, "auto", "auto");
114 # $self->_add_mode_button ($vb, "top", "top");
115 # $self->_add_mode_button ($vb, "above floor", "above");
116 # $self->_add_mode_button ($vb, "below floor", "below");
117 # $self->_add_mode_button ($vb, "bottom", "bottom");
118 #
119 # $self->{widget} = $vb;
120 }
121
122 package GCE::EditAction::Pick;
123 use GCE::ArchRef;
124 use GCE::Util;
125 use strict;
126
127 our @ISA = qw/GCE::EditAction::RadioModed/;
128
129 sub name { 'pick' }
130
131 sub want_cursor { 0 }
132
133 sub only_on_click { 1 }
134
135 sub special_arrow { 'GDK_HAND2' }
136
137 sub init {
138 my ($self) = @_;
139
140 my $vb = new Gtk2::VBox;
141 $self->{widget} = $vb;
142 }
143
144 # Pick does not change the stack
145 sub begin {}
146 sub end {}
147
148 sub edit {
149 my ($self, $map, $x, $y) = @_;
150
151 my $cstack = $map->get ($x, $y);
152 my ($ox, $oy) = ($x, $y);
153
154 return unless @$cstack;
155
156 my $arch = $cstack->[-1];
157 ($x, $y, $arch, $cstack) = devirtualize ($map, $x, $y, $arch, $cstack);
158
159 my $aref =
160 GCE::ArchRef->new (
161 arch => $arch,
162 source => 'map',
163 cb => sub {
164 $map->change_begin ('attredit');
165 $map->change_stack ($x, $y, $cstack);
166
167 if (my $changeset = $map->change_end) {
168 splice @{ $map->{undo_stack} ||= [] },
169 $map->{undo_stack_pos}++, 1e6,
170 $changeset;
171 }
172 }
173 );
174
175 $::MAINWIN->update_attr_editor ($aref);
176 $::MAINWIN->update_stack_view ($map, $ox, $oy);
177 }
178
179 package GCE::EditAction::Perl;
180
181 use GCE::Util;
182 use Gtk2;
183 use strict;
184
185 our @ISA = qw/GCE::EditAction/;
186
187 sub name { 'perl' }
188
189 sub special_arrow { 'GDK_HEART' }
190
191 sub init {
192 my ($self) = @_;
193
194 my $vb = new Gtk2::VBox;
195 $vb->pack_start (my $combo = Gtk2::ComboBox->new_text, 0, 1, 0);
196 $vb->pack_start (my $sw = Gtk2::ScrolledWindow->new, 1, 1, 0);
197 $sw->add ($self->{txt} = Gtk2::TextView->new);
198
199 my $code = {};
200 for (['unique floor' => 'my $i = 0; for (@$os) { $_->{is_floor} and $as->[$i]->{unique} = 1; $i++ }']) {
201 $combo->append_text ($_->[0]);
202 $code->{$_->[0]} = $_->[1];
203 }
204
205 $combo->signal_connect (changed => sub {
206 my ($combo) = @_;
207 my $str = $combo->get_active_text;
208 $self->{txt}->get_buffer->set_text ($code->{$str});
209 });
210
211 $self->tool_widget ($vb);
212 }
213
214 sub want_cursor { 0 }
215
216 sub edit {
217 my ($self, $map, $x, $y) = @_;
218
219 my $pick = $::MAINWIN->get_pick;
220 my $as = $map->get ($x, $y);
221
222 $as = $self->eval ($map, $pick, $as, $x, $y);
223 $map->change_stack ($x, $y, $as); # insert_arch_stack_layer ($as, $arch));
224 }
225
226 sub eval {
227 my ($self, $map, $pick, $as, $x, $y) = @_;
228 my $buf = $self->{txt}->get_buffer;
229 my $code = $buf->get_text ($buf->get_start_iter, $buf->get_end_iter, 0);
230 my $f_idx = stack_find_floor ($as, 'from_top');
231 my $w_idx = stack_find_wall ($as, 'from_top');
232 my $os = [ map { $Deliantra::ARCH{$_->{_name}} } @$as ];
233
234 unless (arch_is_floor ($as->[$f_idx])) { $f_idx = undef; }
235 unless (arch_is_floor ($as->[$w_idx])) { $w_idx = undef; }
236
237 eval $code;
238 return $as;
239 }
240
241 package GCE::EditAction::FollowExit;
242 use Storable qw/dclone/;
243 use File::Spec::Functions;
244 use GCE::Util;
245 use Gtk2;
246 use strict;
247
248 our @ISA = qw/GCE::EditAction/;
249
250 sub name { 'place' }
251
252 sub init {
253 my ($self) = @_;
254
255 my $vb = new Gtk2::VBox;
256
257 $self->tool_widget ($vb);
258 }
259
260 sub want_cursor { 0 }
261
262 sub edit {
263 my ($self, $map, $x, $y, $mape) = @_;
264
265 my $as = $map->get ($x, $y);
266
267 my $exit;
268 for my $arch (@$as) {
269 my ($rx, $ry, $rarch) = devirtualize ($map, $x, $y, $arch, $as);
270 if (arch_is_exit ($rarch)) {
271 $exit = $rarch;
272 }
273 }
274
275 if ($exit and $exit->{slaying} !~ /^!/) {
276 my $dest = map2abs ($exit->{slaying}, $mape);
277 my $file = $dest;
278 # XXX: Replace with statusbar message
279 unless (-f $file) {
280 $file .= ".map";
281 unless (-f $file) {
282 quick_msg ($mape, "Couldn't find map file at '$dest' or '$dest.map'.", 1);
283 return
284 }
285 }
286 $::MAINWIN->open_map_editor ($file);
287 }
288 }
289
290 package GCE::EditAction::Place;
291
292 use Storable qw/dclone/;
293 use GCE::Util;
294 use Gtk2;
295 use strict;
296
297 our @ISA = qw/GCE::EditAction::RadioModed/;
298
299 sub name { 'place' }
300
301 sub init {
302 my ($self) = @_;
303
304 my $vb = new Gtk2::VBox;
305
306 $self->add_mode_button ($vb, "auto", "auto");
307 $self->add_mode_button ($vb, "top", "top");
308 $self->add_mode_button ($vb, "above floor", "above");
309 $self->add_mode_button ($vb, "below floor", "below");
310 $self->add_mode_button ($vb, "bottom", "bottom");
311
312 $self->tool_widget ($vb);
313 }
314
315 sub want_cursor { 0 }
316
317 # 1 up 2 right 4 down 8 left
318 my @join_ext = (
319 "0", # 0
320 "1_2", # 1
321 "1_4", # 2
322 "2_2_1", # 3
323 "1_1", # 4
324 "2_1_1", # 5
325 "2_2_2", # 6
326 "3_2", # 7
327 "1_3", # 8
328 "2_2_4", # 9
329 "2_1_2", # 10
330 "3_1", # 11
331 "2_2_3", # 12
332 "3_4", # 13
333 "3_3", # 14
334 "4", # 15
335 );
336
337 sub autojoin {
338 my ($map, $pick, $x1, $y1, $x2, $y2) = @_;
339
340 my $dx = $x2 - $x1;
341 my $dy = $y2 - $y1;
342
343 my $dir = $dy ? ($dy == -1 ? 1 : $dy == 1 ? 4 : return)
344 : ($dx == -1 ? 8 : $dx == 1 ? 2 : $dx == 0 ? 0 : return);
345
346 my $as = $map->get ($x1, $y1);
347
348 (my $base = $pick->{_name}) =~ s/_0$//;
349
350 for my $idx (0 .. $#$as) {
351 my $arch = $as->[$idx];
352 for my $dirs (0..15) {
353 my $name = $arch->{_name};
354
355 if ($arch->{_name} eq "$base\_$join_ext[$dirs]") {
356 $dirs |= $dir;
357
358 my $name = "$base\_$join_ext[$dirs]";
359
360 if ($Deliantra::ARCH{$name}) {
361 %$arch = ( _name => $name );
362 $map->change_stack ($x1, $y1, $as);
363
364 return 1;
365 }
366 }
367 }
368 }
369
370 return 0;
371 }
372
373 sub edit {
374 my ($self, $map, $x, $y) = @_;
375
376 my $pick = $::MAINWIN->get_pick;
377 my $as = $map->get ($x, $y);
378
379 my $autojoin = $pick->{_name} =~ /_0$/
380 && $self->get_mode eq "auto";
381
382 autojoin $map, $pick, @{$self->{last_pos}}, $x, $y
383 if $autojoin && $self->{last_pos};
384
385 if (!$autojoin
386 || !($self->{last_pos} ? autojoin $map, $pick, $x, $y, @{$self->{last_pos}},
387 : autojoin $map, $pick, $x, $y, $x, $y)) {
388 $self->stack_action ($as, dclone $pick);
389 $map->change_stack ($x, $y, $as);
390 autojoin $map, $pick, $x, $y, @{$self->{last_pos}}
391 if $autojoin && $self->{last_pos};
392 }
393
394 $self->{last_pos} = [$x, $y];
395 }
396
397 sub end {
398 my ($self, $map, $x, $y, $mape) = @_;
399
400 # now actualize stack and attr editor
401 $::MAINWIN->update_stack_view ($map, $x, $y);
402
403 my $cstack = $map->get ($x, $y);
404
405 my $arch = $cstack->[-1];
406
407 delete $self->{last_pos};
408
409 # virtual... grmbl....
410 # FIXME: I have to patch the stack of the real arch??? argl.. how??
411 if ($arch->{_virtual}) {
412 $x = $arch->{virtual_x};
413 $y = $arch->{virtual_y};
414 $arch = $arch->{_virtual};
415 $cstack = $map->get ($x, $y);
416 }
417
418 $self->SUPER::end ($map, $x, $y, $mape);
419 }
420
421 sub stack_action {
422 my ($self, $stack, $arch) = @_;
423
424 my $m = $self->get_mode;
425
426 if ($m eq 'top') {
427 if (@$stack == 0 or $stack->[-1]->{_name} ne $arch->{_name}) {
428 push @$stack, $arch;
429 }
430
431 } elsif ($m eq 'bottom') {
432 if (@$stack == 0 or $stack->[0]->{_name} ne $arch->{_name}) {
433 unshift @$stack, $arch;
434 }
435
436 } elsif ($m eq 'above') {
437 my $fidx = stack_find_floor ($stack, 'from_top');
438
439 if (@$stack == 0
440 or not ($stack->[$fidx + 1])
441 or $stack->[$fidx + 1]->{_name} ne $arch->{_name})
442 {
443 splice (@$stack, $fidx + 1, 0, $arch);
444 }
445
446 } elsif ($m eq 'below') {
447 my $fidx = stack_find_floor ($stack, 'from_bottom');
448
449 if (@$stack == 0
450 or $fidx == 0
451 or not ($stack->[$fidx - 1])
452 or $stack->[$fidx - 1]->{_name} ne $arch->{_name})
453 {
454 splice (@$stack, $fidx, 0, $arch);
455 }
456
457 } elsif ($m eq 'auto') {
458 my $fidx = stack_find_floor ($stack, 'from_top');
459 my $widx = stack_find_wall ($stack);
460
461 if (arch_is_floor ($arch)) { # we want to place a floor tile
462
463 if (arch_is_floor ($stack->[$fidx])) { # replace
464 $stack->[$fidx] = $arch;
465
466 } else { # insert on bottom
467 unshift @$stack, $arch;
468 }
469
470 } elsif (arch_is_wall ($arch)) { # we want to place a wall
471
472 if (arch_is_wall ($stack->[$widx])) { # replace
473 $stack->[$widx] = $arch;
474
475 } else { # insert above floor
476 splice (@$stack, $fidx + 1, 0, $arch);
477 }
478
479 } else {
480
481 if (arch_is_wall ($stack->[$widx])) {
482 # if we have a wall above the floor, replace it with the to place item
483 $stack->[$widx] = $arch;
484 return;
485 }
486
487 if (@$stack == 0
488 or not ($stack->[-1])
489 or $stack->[-1]->{_name} ne $arch->{_name})
490 {
491 push @$stack, $arch;
492
493 } elsif ($stack->[-1]->{_name} eq $arch->{_name}) {
494 $stack->[-1] = $arch;
495 }
496 }
497 }
498 }
499
500 package GCE::EditAction::Select;
501 use GCE::Util;
502 use Gtk2;
503 use Deliantra;
504 use Storable qw/dclone/;
505 use strict;
506
507 our @ISA = qw/GCE::EditAction::RadioModed/;
508
509 sub name { 'select' }
510
511 sub special_arrow { 'GDK_CIRCLE' }
512
513 sub init {
514 my ($self) = @_;
515
516 my $vb = new Gtk2::VBox;
517
518 $vb->pack_start (my $bt = Gtk2::Button->new_with_mnemonic ("_copy"), 0, 1, 0);
519 $bt->signal_connect (clicked => sub { $self->copy });
520 $vb->pack_start ($self->{paste_top} = Gtk2::CheckButton->new ('paste on top'), 0, 1, 0);
521 $vb->pack_start (my $bt = Gtk2::Button->new_with_mnemonic ("paste (_v)"), 0, 1, 0);
522 $bt->signal_connect (clicked => sub { $self->paste });
523 $vb->pack_start (Gtk2::HSeparator->new, 0, 1, 0);
524 $self->add_mode_button ($vb, "place", "place");
525 $self->add_mode_button ($vb, "erase", "erase");
526 $self->add_mode_button ($vb, "perl", "perl");
527 $vb->pack_start (my $bt = Gtk2::Button->new_with_mnemonic ("i_nvoke"), 0, 1, 0);
528 $bt->signal_connect (clicked => sub { $self->invoke });
529
530 $self->tool_widget ($vb);
531 }
532
533 sub copy {
534 my ($self) = @_;
535
536 return unless $self->{selection}->{a};
537 my ($x1, $y1) = @{$self->{selection}->{a}};
538 my ($x2, $y2) = @{$self->{selection}->{b}};
539
540 if ($x1 > $x2) { ($x2, $x1) = ($x1, $x2) }
541 if ($y1 > $y2) { ($y2, $y1) = ($y1, $y2) }
542
543 my $map = $self->{selection}->{map};
544
545 $self->{copy_coords} = [$x1, $y1, $x2, $y2];
546 $self->{copy};
547 for (my $x = $x1; $x <= $x2; $x++) {
548 for (my $y = $y1; $y <= $y2; $y++) {
549 $self->{copy}->[$x - $x1]->[$y - $y1] = $map->get ($x, $y);
550 }
551 }
552 }
553
554 sub paste {
555 my ($self, $map, $xp, $yp) = @_;
556
557 return unless $self->{selection}->{a};
558
559 my ($x1, $y1);
560
561 if (defined $xp) {
562 ($x1, $y1) = ($xp, $yp);
563 } else {
564 ($x1, $y1) = @{$self->{selection}->{a}};
565 }
566
567 $map ||= $self->{selection}->{map};
568
569 my $p_o_top = $self->{paste_top}->get_active * 1;
570
571 my $w = $self->{copy_coords}->[2] - $self->{copy_coords}->[0];
572 my $h = $self->{copy_coords}->[3] - $self->{copy_coords}->[1];
573 $self->{copy};
574 $self->SUPER::begin ($map, $x1, $y1);
575 for (my $x = $x1; $x <= ($x1 + $w); $x++) {
576 for (my $y = $y1; $y <= ($y1 + $h); $y++) {
577 my $cstck = $map->get ($x, $y);
578
579 if ($p_o_top) {
580 push @$cstck, @{dclone ($self->{copy}->[$x - $x1]->[$y - $y1] || [])};
581 $map->change_stack ($x, $y, $cstck);
582 } else {
583 $map->change_stack ($x, $y, dclone ($self->{copy}->[$x - $x1]->[$y - $y1] || []));
584 }
585 }
586 }
587 $self->SUPER::end ($map);
588 $map->invalidate_all;
589 }
590
591 sub invoke {
592 my ($self) = @_;
593
594 return unless $self->{selection}->{a};
595 my ($x1, $y1) = @{$self->{selection}->{a}};
596 my ($x2, $y2) = @{$self->{selection}->{b}};
597
598 if ($x1 > $x2) { ($x2, $x1) = ($x1, $x2) }
599 if ($y1 > $y2) { ($y2, $y1) = ($y1, $y2) }
600
601 my $map = $self->{selection}->{map};
602
603 my $m = $self->get_mode;
604 $self->SUPER::begin ($map, $x1, $y1);
605 for (my $x = $x1; $x <= $x2; $x++) {
606 for (my $y = $y1; $y <= $y2; $y++) {
607 if ($m eq 'place') {
608 $::MAINWIN->{edit_collection}{place}->edit ($map, $x, $y);
609 } elsif ($m eq 'erase') {
610 $::MAINWIN->{edit_collection}{erase}->edit ($map, $x, $y);
611 } elsif ($m eq 'perl') {
612 $::MAINWIN->{edit_collection}{perl}->edit ($map, $x, $y);
613 }
614 }
615 }
616 $self->SUPER::end ($map);
617 }
618
619 sub want_cursor { 0 }
620
621 sub begin {
622 my ($self, $map, $x, $y) = @_;
623
624 if ($self->{selection}->{map}) {
625 $self->{selection}->{map}->overlay ('selection');
626 }
627 delete $self->{selection};
628
629 $self->{selection}->{a} = [$x, $y];
630 }
631
632 sub end {
633 }
634
635 sub edit {
636 my ($self, $map, $x, $y) = @_;
637
638 $self->{selection}->{b} = [$x, $y];
639 $self->{selection}->{map} = $map;
640 $self->update_overlay ();
641 }
642
643 sub update_overlay {
644 my ($self) = @_;
645
646 my $map = $self->{selection}->{map};
647
648 return unless (defined $self->{selection}->{a} and defined $self->{selection}->{b});
649
650 my ($x1, $y1) = @{$self->{selection}->{a}};
651 my ($x2, $y2) = @{$self->{selection}->{b}};
652
653 if ($x1 > $x2) { ($x2, $x1) = ($x1, $x2) }
654 if ($y1 > $y2) { ($y2, $y1) = ($y1, $y2) }
655
656 my $w = ($x2 - $x1) + 1;
657 my $h = ($y2 - $y1) + 1;
658
659 $map->overlay (selection =>
660 $x1 * TILESIZE, $y1 * TILESIZE,
661 $w * TILESIZE, $h * TILESIZE,
662 sub {
663 my ($self, $x, $y) = @_;
664 $self->{window}->draw_rectangle (
665 $_ & 1 ? $self->style->black_gc : $self->style->white_gc,
666 0,
667 $x + $_, $y + $_,
668 ($w * TILESIZE) - 1 - $_ * 2,
669 ($h * TILESIZE) - 1 - $_ * 2
670 ) for 0..3;
671 }
672 );
673 }
674
675 package GCE::EditAction::Erase;
676 use GCE::Util;
677 use Gtk2;
678 use strict;
679
680 our @ISA = qw/GCE::EditAction::RadioModed/;
681
682 sub name { 'erase' }
683
684 sub want_cursor { 0 }
685
686 sub special_arrow { 'GDK_DIAMOND_CROSS' }
687
688 sub init {
689 my ($self) = @_;
690
691 my $vb = new Gtk2::VBox;
692 $self->add_mode_button ($vb, "top", "top");
693 $self->add_mode_button ($vb, "walls", "walls");
694 $self->add_mode_button ($vb, "above floor", "above", 'default');
695 $self->add_mode_button ($vb, "floor", "floor");
696 $self->add_mode_button ($vb, "below floor", "below");
697 $self->add_mode_button ($vb, "bottom", "bottom");
698 $self->add_mode_button ($vb, "pick match", "match");
699
700 $self->tool_widget ($vb);
701
702 $vb->pack_start ($self->{no_wall_check} = Gtk2::CheckButton->new ("protect walls"), 0, 1, 0);
703 $vb->pack_start ($self->{no_monsters_check} = Gtk2::CheckButton->new ("protect monsters"), 0, 1, 0);
704 }
705
706 sub check_excluded {
707 my ($self, $arch) = @_;
708
709 my $r = ($self->{no_wall_check}->get_active && arch_is_wall ($arch))
710 || ($self->{no_monsters_check}->get_active && arch_is_monster ($arch));
711
712 return $r;
713 }
714
715 sub edit {
716 my ($self, $map, $x, $y) = @_;
717
718 my $as = $map->get ($x, $y);
719 $self->stack_action ($as);
720 $map->change_stack ($x, $y, $as);
721 }
722
723 sub stack_action {
724 my ($self, $stack) = @_;
725
726 my $m = $self->get_mode;
727
728 if ($m eq 'top') {
729 pop @$stack;
730
731 } elsif ($m eq 'bottom') {
732 shift @$stack;
733
734 } elsif ($m eq 'above') {
735 my $fidx = stack_find_floor ($stack, 'from_top');
736
737 if (arch_is_floor ($stack->[$fidx]) and $stack->[$fidx + 1]) {
738 splice (@$stack, $fidx + 1, 1)
739 unless $self->check_excluded ($stack->[$fidx + 1])
740
741 } elsif (not arch_is_floor ($stack->[$fidx])) {
742 splice (@$stack, $fidx, 1)
743 unless $self->check_excluded ($stack->[$fidx])
744
745 }
746
747 } elsif ($m eq 'below') {
748 my $fidx = stack_find_floor ($stack, 'from_bottom');
749
750 if ($fidx > 0 and not arch_is_floor ($stack->[$fidx - 1])) {
751 splice (@$stack, $fidx - 1, 1)
752 unless $self->check_excluded ($stack->[$fidx - 1])
753
754 } elsif (not arch_is_floor ($stack->[$fidx])) { # no floor found
755 splice (@$stack, $fidx, 1)
756 unless $self->check_excluded ($stack->[$fidx])
757
758 }
759
760 } elsif ($m eq 'walls') {
761 my $widx = stack_find_wall ($stack, 'from_top');
762
763 while (arch_is_wall ($stack->[$widx])) {
764 splice (@$stack, $widx, 1);
765 $widx = stack_find_wall ($stack, 'from_top')
766 }
767
768 } elsif ($m eq 'floor') {
769 my $fidx = stack_find_floor ($stack, 'from_top');
770
771 while (arch_is_floor ($stack->[$fidx])) {
772 splice (@$stack, $fidx, 1);
773 $fidx = stack_find_floor ($stack, 'from_top')
774 }
775
776 } elsif ($m eq 'match') {
777 my $pick_name = $::MAINWIN->get_pick ()->{_name};
778 my $idx = stack_find ($stack, 'from_top', sub { $_[0]->{_name} eq $pick_name });
779
780 while ($stack->[$idx] and $stack->[$idx]->{_name} eq $pick_name) {
781 splice (@$stack, $idx, 1);
782 $idx = stack_find ($stack, 'from_top', sub { $_[0]->{_name} eq $pick_name });
783 }
784 }
785 }
786
787 package GCE::EditAction::Connect;
788 use Storable qw/dclone/;
789 use GCE::Util;
790 use Gtk2;
791 use File::Spec::Functions;
792 use strict;
793
794 our @ISA = qw/GCE::EditAction::RadioModed/;
795
796 sub name { 'connect' }
797
798 sub init {
799 my ($self) = @_;
800
801 my $vb = new Gtk2::VBox;
802 $self->add_mode_button ($vb, "auto", "auto", 1);
803 $self->add_mode_button ($vb, "exit", "exit");
804 $self->add_mode_button ($vb, "connect", "connect");
805
806 $vb->pack_start (my $l = Gtk2::Label->new, 0, 0, 0);
807 $l->set_text ("connection:");
808 $vb->pack_start ($self->{pcon} = Gtk2::SpinButton->new_with_range (1, 10000, 1), 0, 1, 0);
809 $vb->pack_start ($self->{sel_lbl} = Gtk2::Label->new, 0, 0, 0);
810 $self->tool_widget ($vb);
811 }
812
813 sub want_cursor { 0 }
814
815 #XXX: change_begin/end is handled in edit
816 sub begin { }
817 sub end { }
818
819 sub edit {
820 my ($self, $map, $x, $y, $mapedit) = @_;
821
822 my $pick = $::MAINWIN->get_pick;
823 my $as = $map->get ($x, $y);
824
825 my $mode = $self->get_mode;
826
827 my $exit;
828 my $conns = [];
829 for (@$as) {
830 if ($_->{_virtual}) { #FIXME: implement virtual handling for connect
831 return;
832 }
833 if (arch_is_connector ($_)) {
834 push @$conns, $_;
835 }
836 if (arch_is_exit ($_)) {
837 $exit = $_;
838 }
839 }
840
841 if ($mode eq 'auto') {
842 $conns = [] if $exit;
843 } elsif ($mode eq 'exit') {
844 $conns = [];
845 } elsif ($mode eq 'connect') {
846 $exit = undef;
847 }
848
849 my $mappath = $::MAPDIR;
850
851 if ($exit) {
852 if ($self->{sel_exit}) {
853
854 $exit->{hp} = $self->{sel_exit}->[3];
855 $exit->{sp} = $self->{sel_exit}->[4];
856 #$exit->{slaying} = File::Spec->abs2rel ($self->{sel_exit}->[5], $ent);
857
858 my $exit2 = $self->{sel_exit}->[0];
859
860 $exit2->{hp} = $x;
861 $exit2->{sp} = $y;
862
863 my ($m1, $m2) = exit_paths ($mappath, $self->{sel_exit}->[5], $mapedit->{path});
864
865 $exit2->{slaying} = $m2;
866 $exit->{slaying} = $m1;
867
868 $self->SUPER::begin ($map, $x, $y, $mapedit);
869 $map->change_stack ($x, $y, $as);
870 $self->SUPER::end ($map);
871 $self->SUPER::begin ($self->{sel_exit}->[1], $exit->{hp}, $exit->{sp});
872 $self->{sel_exit}->[1]->change_stack ($exit->{hp}, $exit->{sp}, $self->{sel_exit}->[2]);
873 $self->SUPER::end ($self->{sel_exit}->[1]);
874
875 quick_msg ($mapedit, "$exit->{slaying} ($exit->{hp}:$exit->{sp}) $exit->{_name} <=> $exit2->{slaying} ($exit2->{hp}:$exit2->{sp}) $exit2->{_name}", 0);
876
877 $::MAINWIN->{edit_collection}{pick}->edit ($map, $x, $y);
878
879 $self->{sel_exit} = undef;
880 $self->{sel_lbl}->set_text ('');
881 } else {
882 $self->{sel_lbl}->set_text ("src: ($x:$y) $exit->{_name}");
883 $self->{sel_exit} = [$exit, $map, $as, $x, $y, $mapedit->{path}];
884 }
885 } elsif (@$conns) {
886 for (@$conns) {
887 $_->{connected} = $self->{pcon}->get_value;
888 }
889 $self->SUPER::begin ($map, $x, $y, $mapedit);
890 $map->change_stack ($x, $y, $as);
891 $self->SUPER::end ($map);
892 } elsif ($self->{sel_exit}) {
893 my $exit2 = $self->{sel_exit}->[0];
894
895 $exit2->{hp} = $x;
896 $exit2->{sp} = $y;
897 $exit2->{slaying} = undef;
898
899 $self->SUPER::begin ($self->{sel_exit}->[1], $self->{sel_exit}->[3], $self->{sel_exit}->[4]);
900 $self->{sel_exit}->[1]->change_stack ($self->{sel_exit}->[3], $self->{sel_exit}->[4], $self->{sel_exit}->[2]);
901 $self->SUPER::end ($self->{sel_exit}->[1]);
902
903 quick_msg ($mapedit, "($self->{sel_exit}->[3]:$self->{sel_exit}->[4]) $self->{sel_exit}->[0]->{_name} => ($x:$y)", 0);
904
905 $::MAINWIN->{edit_collection}{pick}->edit ($map, $x, $y);
906
907 $self->{sel_exit} = undef;
908 $self->{sel_lbl}->set_text ('');
909 } else {
910 quick_msg ($mapedit, "no exit or connection object found");
911 }
912 }
913
914
915 =head1 AUTHOR
916
917 Marc Lehmann <schmorp@schmorp.de>
918 http://home.schmorp.de/
919
920 Robin Redeker <elmex@ta-sa.org>
921 http://www.ta-sa.org/
922
923 =cut
924
925 1
926