ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/gde/GCE/EditAction.pm
Revision: 1.36
Committed: Fri May 5 11:26:35 2006 UTC (18 years, 1 month ago) by elmex
Branch: MAIN
Changes since 1.35: +3 -0 lines
Log Message:
fixed a semantic bug in the auto placement

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