ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/gde/GCE/EditAction.pm
Revision: 1.42
Committed: Thu Jun 29 09:45:17 2006 UTC (17 years, 11 months ago) by elmex
Branch: MAIN
Changes since 1.41: +4 -0 lines
Log Message:
Implemented some todo items:
- ctrl+r fuer redo
- pick is click
- map name anzeigen (z.b. title)
And added shopheaders to the map properties along with documentation
in the gce manual for the headers.

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