ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/gde/GCE/EditAction.pm
Revision: 1.34
Committed: Tue Apr 4 21:12:08 2006 UTC (18 years, 2 months ago) by elmex
Branch: MAIN
Changes since 1.33: +31 -11 lines
Log Message:
Changed updating of attribute editor and inventory editor in a major manner.
We have now an abstraction layer between attribute editor and arch/object that
handles updating of the map and calling change_begin/set/end.

Works fine after testing, please watchout for bugs in attribute editor,
inventory editor and updating of these.

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