| … | |
… | |
| 423 | |
423 | |
| 424 | $_->[4]->($self, $_->[0] - $self->{x}, $_->[1] - $self->{y}) |
424 | $_->[4]->($self, $_->[0] - $self->{x}, $_->[1] - $self->{y}) |
| 425 | for values %{ $self->{overlay} || {} }; |
425 | for values %{ $self->{overlay} || {} }; |
| 426 | } |
426 | } |
| 427 | |
427 | |
|
|
428 | # get head from _virtual tile, returning x, y, z and @$stack |
|
|
429 | sub get_head { |
|
|
430 | my ($self, $virtual) = @_; |
|
|
431 | |
|
|
432 | my ($x, $y) = @$self{qw(_virtual_x _virtual_y)} |
|
|
433 | or return; |
|
|
434 | |
|
|
435 | my $stack = $self->{map}{map}[$x][$y] |
|
|
436 | or return; |
|
|
437 | |
|
|
438 | my ($z) = grep $stack->[$_] == $virtual->{_virtual}, 0..$#$stack |
|
|
439 | or return; |
|
|
440 | |
|
|
441 | ($x, $y, $z, $self->get ($x, $y)) |
|
|
442 | } |
|
|
443 | |
| 428 | sub get { |
444 | sub get { |
| 429 | my ($self, $x, $y) = @_; |
445 | my ($self, $x, $y) = @_; |
| 430 | |
446 | |
| 431 | return unless $x >= 0 && $x < $self->{map}{width} |
447 | return unless $x >= 0 && $x < $self->{map}{width} |
| 432 | && $y >= 0 && $y < $self->{map}{height}; |
448 | && $y >= 0 && $y < $self->{map}{height}; |
| 433 | |
449 | |
| 434 | Storable::dclone $self->{map}{map}[$x][$y] || [] |
450 | Storable::dclone [ |
|
|
451 | map +{ %$_, ((exists $_->{_virtual}) ? (_virtual => 0+$_->{_virtual}) : ()) }, |
|
|
452 | @{ $self->{map}{map}[$x][$y] || [] } |
|
|
453 | ] |
| 435 | } |
454 | } |
| 436 | |
455 | |
| 437 | sub set { |
456 | sub set { |
| 438 | my ($self, $x, $y, $as) = @_; |
457 | my ($self, $x, $y, $as) = @_; |
| 439 | |
458 | |
