ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/gde/GCE/EditAction.pm
Revision: 1.44
Committed: Sun Dec 17 20:24:46 2006 UTC (17 years, 5 months ago) by elmex
Branch: MAIN
CVS Tags: rel-2_0
Changes since 1.43: +2 -2 lines
Log Message:
added picker group finding from object samples

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