ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/gde/GCE/EditAction.pm
Revision: 1.47
Committed: Sun Jun 24 08:09:34 2007 UTC (16 years, 11 months ago) by elmex
Branch: MAIN
Changes since 1.46: +1 -0 lines
Log Message:
moved the buttons in the attribute editor into a menu and
added a button which displays the source of the selected
archetype for now until some better mechanism is found.

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