ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/gde/GCE/EditAction.pm
Revision: 1.35
Committed: Thu Apr 20 08:58:29 2006 UTC (18 years, 1 month ago) by elmex
Branch: MAIN
Changes since 1.34: +2 -1 lines
Log Message:
fixed two bugs: stack view wasn't correctly updated when picking a stack with a
virtual tile. And the msg/lore textviews in the attreditor were broken.

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 }
536 }
537 }
538
539 package GCE::EditAction::Select;
540 use GCE::Util;
541 use Gtk2;
542 use Crossfire;
543 use Storable qw/dclone/;
544 use strict;
545
546 our @ISA = qw/GCE::EditAction::RadioModed/;
547
548 sub name { 'select' }
549
550 sub special_arrow { 'GDK_CIRCLE' }
551
552 sub init {
553 my ($self) = @_;
554
555 my $vb = new Gtk2::VBox;
556
557 $vb->pack_start (my $bt = Gtk2::Button->new_with_mnemonic ("_copy"), 0, 1, 0);
558 $bt->signal_connect (clicked => sub { $self->copy });
559 $vb->pack_start ($self->{paste_top} = Gtk2::CheckButton->new ('paste on top'), 0, 1, 0);
560 $vb->pack_start (my $bt = Gtk2::Button->new_with_mnemonic ("paste (_v)"), 0, 1, 0);
561 $bt->signal_connect (clicked => sub { $self->paste });
562 $vb->pack_start (Gtk2::HSeparator->new, 0, 1, 0);
563 $self->add_mode_button ($vb, "place", "place");
564 $self->add_mode_button ($vb, "erase", "erase");
565 $self->add_mode_button ($vb, "perl", "perl");
566 $vb->pack_start (my $bt = Gtk2::Button->new_with_mnemonic ("i_nvoke"), 0, 1, 0);
567 $bt->signal_connect (clicked => sub { $self->invoke });
568
569 $self->tool_widget ($vb);
570 }
571
572 sub copy {
573 my ($self) = @_;
574
575 return unless $self->{selection}->{a};
576 my ($x1, $y1) = @{$self->{selection}->{a}};
577 my ($x2, $y2) = @{$self->{selection}->{b}};
578
579 if ($x1 > $x2) { ($x2, $x1) = ($x1, $x2) }
580 if ($y1 > $y2) { ($y2, $y1) = ($y1, $y2) }
581
582 my $map = $self->{selection}->{map};
583
584 $self->{copy_coords} = [$x1, $y1, $x2, $y2];
585 $self->{copy};
586 for (my $x = $x1; $x <= $x2; $x++) {
587 for (my $y = $y1; $y <= $y2; $y++) {
588 $self->{copy}->[$x - $x1]->[$y - $y1] = $map->get ($x, $y);
589 }
590 }
591 }
592
593 sub paste {
594 my ($self, $map, $xp, $yp) = @_;
595
596 return unless $self->{selection}->{a};
597
598 my ($x1, $y1);
599
600 if (defined $xp) {
601 ($x1, $y1) = ($xp, $yp);
602 } else {
603 ($x1, $y1) = @{$self->{selection}->{a}};
604 }
605
606 $map ||= $self->{selection}->{map};
607
608 my $p_o_top = $self->{paste_top}->get_active * 1;
609
610 my $w = $self->{copy_coords}->[2] - $self->{copy_coords}->[0];
611 my $h = $self->{copy_coords}->[3] - $self->{copy_coords}->[1];
612 $self->{copy};
613 $self->SUPER::begin ($map, $x1, $y1);
614 for (my $x = $x1; $x <= ($x1 + $w); $x++) {
615 for (my $y = $y1; $y <= ($y1 + $h); $y++) {
616 my $cstck = $map->get ($x, $y);
617
618 if ($p_o_top) {
619 push @$cstck, @{dclone ($self->{copy}->[$x - $x1]->[$y - $y1] || [])};
620 $map->change_stack ($x, $y, $cstck);
621 } else {
622 $map->change_stack ($x, $y, dclone ($self->{copy}->[$x - $x1]->[$y - $y1] || []));
623 }
624 }
625 }
626 $self->SUPER::end ($map);
627 $map->invalidate_all;
628 }
629
630 sub invoke {
631 my ($self) = @_;
632
633 return unless $self->{selection}->{a};
634 my ($x1, $y1) = @{$self->{selection}->{a}};
635 my ($x2, $y2) = @{$self->{selection}->{b}};
636
637 if ($x1 > $x2) { ($x2, $x1) = ($x1, $x2) }
638 if ($y1 > $y2) { ($y2, $y1) = ($y1, $y2) }
639
640 my $map = $self->{selection}->{map};
641
642 my $m = $self->get_mode;
643 $self->SUPER::begin ($map, $x1, $y1);
644 for (my $x = $x1; $x <= $x2; $x++) {
645 for (my $y = $y1; $y <= $y2; $y++) {
646 if ($m eq 'place') {
647 $::MAINWIN->{edit_collection}{place}->edit ($map, $x, $y);
648 } elsif ($m eq 'erase') {
649 $::MAINWIN->{edit_collection}{erase}->edit ($map, $x, $y);
650 } elsif ($m eq 'perl') {
651 $::MAINWIN->{edit_collection}{perl}->edit ($map, $x, $y);
652 }
653 }
654 }
655 $self->SUPER::end ($map);
656 }
657
658 sub want_cursor { 0 }
659
660 sub begin {
661 my ($self, $map, $x, $y) = @_;
662
663 if ($self->{selection}->{map}) {
664 $self->{selection}->{map}->overlay ('selection');
665 }
666 delete $self->{selection};
667
668 $self->{selection}->{a} = [$x, $y];
669 $self->edit ($map, $x, $y);
670 }
671
672 sub end {
673 }
674
675 sub edit {
676 my ($self, $map, $x, $y) = @_;
677
678 $self->{selection}->{b} = [$x, $y];
679 $self->{selection}->{map} = $map;
680 $self->update_overlay ();
681 }
682
683 sub update_overlay {
684 my ($self) = @_;
685
686 my $map = $self->{selection}->{map};
687
688 return unless (defined $self->{selection}->{a} and defined $self->{selection}->{b});
689
690 my ($x1, $y1) = @{$self->{selection}->{a}};
691 my ($x2, $y2) = @{$self->{selection}->{b}};
692
693 if ($x1 > $x2) { ($x2, $x1) = ($x1, $x2) }
694 if ($y1 > $y2) { ($y2, $y1) = ($y1, $y2) }
695
696 my $w = ($x2 - $x1) + 1;
697 my $h = ($y2 - $y1) + 1;
698
699 $map->overlay (selection =>
700 $x1 * TILESIZE, $y1 * TILESIZE,
701 $w * TILESIZE, $h * TILESIZE,
702 sub {
703 my ($self, $x, $y) = @_;
704 $self->{window}->draw_rectangle (
705 $_ & 1 ? $self->style->black_gc : $self->style->white_gc,
706 0,
707 $x + $_, $y + $_,
708 ($w * TILESIZE) - 1 - $_ * 2,
709 ($h * TILESIZE) - 1 - $_ * 2
710 ) for 0..3;
711 }
712 );
713 }
714
715 package GCE::EditAction::Erase;
716 use GCE::Util;
717 use Gtk2;
718 use strict;
719
720 our @ISA = qw/GCE::EditAction::RadioModed/;
721
722 sub name { 'erase' }
723
724 sub want_cursor { 0 }
725
726 sub special_arrow { 'GDK_DIAMOND_CROSS' }
727
728 sub init {
729 my ($self) = @_;
730
731 my $vb = new Gtk2::VBox;
732 $self->add_mode_button ($vb, "top", "top");
733 $self->add_mode_button ($vb, "walls", "walls");
734 $self->add_mode_button ($vb, "above floor", "above", 'default');
735 $self->add_mode_button ($vb, "floor", "floor");
736 $self->add_mode_button ($vb, "below floor", "below");
737 $self->add_mode_button ($vb, "bottom", "bottom");
738 $self->add_mode_button ($vb, "pick match", "match");
739
740 $self->tool_widget ($vb);
741
742 $vb->pack_start ($self->{no_wall_check} = Gtk2::CheckButton->new ("protect walls"), 0, 1, 0);
743 $vb->pack_start ($self->{no_monsters_check} = Gtk2::CheckButton->new ("protect monsters"), 0, 1, 0);
744 }
745
746 sub check_excluded {
747 my ($self, $arch) = @_;
748
749 my $a1 = $self->{no_monsters_check}->get_active;
750 my $a2 = $self->{no_wall_check}->get_active;
751
752 my $r = ($self->{no_wall_check}->get_active && arch_is_wall ($arch))
753 || ($self->{no_monsters_check}->get_active && arch_is_monster ($arch));
754 return $r;
755 }
756
757 sub begin {
758 my ($self, $map, $x, $y) = @_;
759
760 $self->SUPER::begin ($map, $x, $y);
761 $self->edit ($map, $x, $y);
762 }
763
764 sub edit {
765 my ($self, $map, $x, $y) = @_;
766
767 my $as = $map->get ($x, $y);
768 $self->stack_action ($as);
769 $map->change_stack ($x, $y, $as);
770 }
771
772 sub stack_action {
773 my ($self, $stack) = @_;
774
775 my $m = $self->get_mode;
776
777 if ($m eq 'top') {
778 pop @$stack;
779
780 } elsif ($m eq 'bottom') {
781 shift @$stack;
782
783 } elsif ($m eq 'above') {
784 my $fidx = stack_find_floor ($stack, 'from_top');
785
786 if (arch_is_floor ($stack->[$fidx]) and $stack->[$fidx + 1]) {
787 splice (@$stack, $fidx + 1, 1)
788 unless $self->check_excluded ($stack->[$fidx + 1])
789
790 } elsif (not arch_is_floor ($stack->[$fidx])) {
791 splice (@$stack, $fidx, 1)
792 unless $self->check_excluded ($stack->[$fidx])
793
794 }
795
796 } elsif ($m eq 'below') {
797 my $fidx = stack_find_floor ($stack, 'from_bottom');
798
799 if ($fidx > 0 and not arch_is_floor ($stack->[$fidx - 1])) {
800 splice (@$stack, $fidx - 1, 1)
801 unless $self->check_excluded ($stack->[$fidx - 1])
802
803 } elsif (not arch_is_floor ($stack->[$fidx])) { # no floor found
804 splice (@$stack, $fidx, 1)
805 unless $self->check_excluded ($stack->[$fidx])
806
807 }
808
809 } elsif ($m eq 'walls') {
810 my $widx = stack_find_wall ($stack, 'from_top');
811
812 while (arch_is_wall ($stack->[$widx])) {
813 splice (@$stack, $widx, 1);
814 $widx = stack_find_wall ($stack, 'from_top')
815 }
816
817 } elsif ($m eq 'floor') {
818 my $fidx = stack_find_floor ($stack, 'from_top');
819
820 while (arch_is_floor ($stack->[$fidx])) {
821 splice (@$stack, $fidx, 1);
822 $fidx = stack_find_floor ($stack, 'from_top')
823 }
824
825 } elsif ($m eq 'match') {
826 my $pick_name = $::MAINWIN->get_pick ()->{_name};
827 my $idx = stack_find ($stack, 'from_top', sub { $_[0]->{_name} eq $pick_name });
828
829 while ($stack->[$idx] and $stack->[$idx]->{_name} eq $pick_name) {
830 splice (@$stack, $idx, 1);
831 $idx = stack_find ($stack, 'from_top', sub { $_[0]->{_name} eq $pick_name });
832 }
833 }
834 }
835
836 package GCE::EditAction::ConnectExit;
837 use Storable qw/dclone/;
838 use GCE::Util;
839 use Gtk2;
840 use File::Spec::Functions;
841 use strict;
842
843 our @ISA = qw/GCE::EditAction::RadioModed/;
844
845 sub name { 'connectexit' }
846
847 sub init {
848 my ($self) = @_;
849
850 my $vb = new Gtk2::VBox;
851 $self->add_mode_button ($vb, "exit", "exit");
852 # $self->add_mode_button ($vb, "triggers", "trig");
853 $vb->pack_start ($self->{sel_edt} = Gtk2::Entry->new, 0, 1, 0);
854 $self->{sel_edt}->set_text (catfile ($::CFG->{MAPDIR}));
855
856 $vb->pack_start ($self->{sel_lbl} = Gtk2::Label->new, 0, 0, 0);
857 $self->tool_widget ($vb);
858 }
859
860 sub want_cursor { 0 }
861
862 sub begin {
863 my ($self, $map, $x, $y, $mapedit) = @_;
864
865 $self->edit ($map, $x, $y, $mapedit);
866 }
867
868 sub edit {
869 my ($self, $map, $x, $y, $mapedit) = @_;
870
871 my $pick = $::MAINWIN->get_pick;
872 my $as = $map->get ($x, $y);
873
874 my $exit;
875 for (@$as) {
876 if (arch_is_exit ($_)) {
877 $exit = $_;
878 }
879 }
880
881 my $mappath = $::CFG->{MAPDIR};
882
883 if ($exit) {
884 if ($self->{sel_exit}) {
885
886 $exit->{hp} = $self->{sel_exit}->[3];
887 $exit->{sp} = $self->{sel_exit}->[4];
888 #$exit->{slaying} = File::Spec->abs2rel ($self->{sel_exit}->[5], $ent);
889
890 my $exit2 = $self->{sel_exit}->[0];
891
892 $exit2->{hp} = $x;
893 $exit2->{sp} = $y;
894
895 my ($m1, $m2) = exit_paths ($mappath, $self->{sel_exit}->[5], $mapedit->{path});
896
897 $exit2->{slaying} = $m2;
898 $exit->{slaying} = $m1;
899
900 $self->SUPER::begin ($map, $x, $y, $mapedit);
901 $map->change_stack ($x, $y, $as);
902 $self->SUPER::end ($map);
903 $self->SUPER::begin ($self->{sel_exit}->[1], $exit->{hp}, $exit->{sp});
904 $self->{sel_exit}->[1]->change_stack ($exit->{hp}, $exit->{sp}, $self->{sel_exit}->[2]);
905 $self->SUPER::end ($self->{sel_exit}->[1]);
906
907 quick_msg ($mapedit, "$exit->{slaying} ($exit->{hp}:$exit->{sp}) $exit->{_name} <=> $exit2->{slaying} ($exit2->{hp}:$exit2->{sp}) $exit2->{_name}", 0);
908
909 $::MAINWIN->{edit_collection}{pick}->edit ($map, $x, $y);
910
911 $self->{sel_exit} = undef;
912 $self->{sel_lbl}->set_text ('');
913 } else {
914 $self->{sel_lbl}->set_text ("src: ($x:$y) $exit->{_name}");
915 $self->{sel_exit} = [$exit, $map, $as, $x, $y, $mapedit->{path}];
916 }
917 } else {
918 if ($self->{sel_exit}) {
919
920 my $exit2 = $self->{sel_exit}->[0];
921
922 $exit2->{hp} = $x;
923 $exit2->{sp} = $y;
924 $exit2->{slaying} = undef;
925
926 unless ($exit2->{slaying} =~ m/^\.\./) {
927 $exit2->{slaying} = '/' . $exit2->{slaying};
928 }
929
930 $self->SUPER::begin ($self->{sel_exit}->[1], $exit->{hp}, $exit->{sp});
931 $self->{sel_exit}->[1]->change_stack ($self->{sel_exit}->[3], $self->{sel_exit}->[4], $self->{sel_exit}->[2]);
932 $self->SUPER::end ($self->{sel_exit}->[1]);
933
934 quick_msg ($mapedit, "($self->{sel_exit}->[3]:$self->{sel_exit}->[4]) $self->{sel_exit}->[0]->{_name} => ($x:$y) $exit2->{_name}", 0);
935
936 $::MAINWIN->{edit_collection}{pick}->edit ($map, $x, $y);
937
938 $self->{sel_exit} = undef;
939 $self->{sel_lbl}->set_text ('');
940 } else {
941 quick_msg ($mapedit, "no exit object found");
942 }
943 }
944
945 # $self->stack_action ($as, dclone ($pick));
946 #$map->change_stack ($x, $y, $as); # insert_arch_stack_layer ($as, $arch));
947 }
948
949 sub end {}
950
951
952 =head1 AUTHOR
953
954 Marc Lehmann <schmorp@schmorp.de>
955 http://home.schmorp.de/
956
957 Robin Redeker <elmex@ta-sa.org>
958 http://www.ta-sa.org/
959
960 =cut
961
962 1
963