| 1 |
#! perl # optional |
| 2 |
|
| 3 |
# manages the worldmap by directing to other handlers |
| 4 |
|
| 5 |
cf::map->register (qr{^/world/world_(-?\d+)_(-?\d+)(?:_(-?\d+))?$}, 100); |
| 6 |
|
| 7 |
# universal |
| 8 |
our $TILE_W = 50; |
| 9 |
our $TILE_H = 50; |
| 10 |
|
| 11 |
# registry |
| 12 |
our @AREAS; |
| 13 |
|
| 14 |
sub register($$$$$$$@) { |
| 15 |
my $meta = { |
| 16 |
pkg => shift, |
| 17 |
x0 => shift, y0 => shift, z0 => shift, |
| 18 |
x1 => shift, y1 => shift, z1 => shift, |
| 19 |
@_ |
| 20 |
}; |
| 21 |
|
| 22 |
my $pkg = $meta->{pkg}; |
| 23 |
|
| 24 |
@AREAS = sort { $b->{pri} <=> $a->{pri} } |
| 25 |
$meta, |
| 26 |
grep $pkg ne $_->{pkg}, |
| 27 |
@AREAS; |
| 28 |
|
| 29 |
my $isa = \@{"$pkg\::ISA"}; |
| 30 |
|
| 31 |
@$isa = ( |
| 32 |
__PACKAGE__, |
| 33 |
grep __PACKAGE__ ne $_, @$isa |
| 34 |
); |
| 35 |
} |
| 36 |
|
| 37 |
sub format_xyz($$;$) { |
| 38 |
sprintf "/world/world_%03d_%03d%s", |
| 39 |
$_[0], $_[1], |
| 40 |
$_[2] ? sprintf "_%03d", $_[2] : ""; |
| 41 |
} |
| 42 |
|
| 43 |
############################################################################# |
| 44 |
|
| 45 |
sub init { |
| 46 |
my ($self) = @_; |
| 47 |
|
| 48 |
my ($x, $y, $z) = @$self{qw(x y z)} = ($1, $2, $3+0); |
| 49 |
|
| 50 |
# find handler for this area |
| 51 |
for (@AREAS) { |
| 52 |
if ( $_->{x0} <= $x && $x <= $_->{x1} |
| 53 |
&& $_->{y0} <= $y && $y <= $_->{y1} |
| 54 |
&& $_->{z0} <= $z && $z <= $_->{z1} |
| 55 |
) { |
| 56 |
$self->{ox} = $x - $_->{x0}; |
| 57 |
$self->{oy} = $y - $_->{y0}; |
| 58 |
$self->{oz} = $z - $_->{z0}; |
| 59 |
|
| 60 |
bless $self, $_->{pkg}; |
| 61 |
|
| 62 |
$self->init_worldmap; |
| 63 |
|
| 64 |
last; |
| 65 |
} |
| 66 |
|
| 67 |
} |
| 68 |
|
| 69 |
$self->SUPER::init; |
| 70 |
} |
| 71 |
|
| 72 |
sub init_worldmap { |
| 73 |
# only for handlers |
| 74 |
} |
| 75 |
|
| 76 |
sub load_header_orig { |
| 77 |
my ($self) = @_; |
| 78 |
|
| 79 |
my ($x, $y, $z) = @$self{qw(x y z)}; |
| 80 |
|
| 81 |
$self->width ($TILE_W); |
| 82 |
$self->height ($TILE_H); |
| 83 |
|
| 84 |
$self->name (sprintf "'The World' at %+d%+d%+d", $x, $y, $z); |
| 85 |
$self->msg ("worldmap dynamically created by map-world extension"); |
| 86 |
$self->outdoor ($self->{z} >= 0); |
| 87 |
$self->default_region (cf::region::find "wilderness"); |
| 88 |
|
| 89 |
# all possible worldmap tiles also exist |
| 90 |
$self->tile_path (0, format_xyz $x, $y - 1, $z); |
| 91 |
$self->tile_path (1, format_xyz $x + 1, $y, $z); |
| 92 |
$self->tile_path (2, format_xyz $x, $y + 1, $z); |
| 93 |
$self->tile_path (3, format_xyz $x - 1, $y, $z); |
| 94 |
$self->tile_path (4, format_xyz $x, $y, $z + 1); |
| 95 |
$self->tile_path (5, format_xyz $x, $y, $z - 1); |
| 96 |
|
| 97 |
# an overlay always wins |
| 98 |
my $overlay = sprintf "%s/%s.map", $cf::MAPDIR, format_xyz $x, $y, $z; |
| 99 |
|
| 100 |
$self->{load_path} = $overlay |
| 101 |
unless Coro::AIO::aio_stat $overlay; |
| 102 |
|
| 103 |
$self->{need_create_treasure} = 1; |
| 104 |
|
| 105 |
1 |
| 106 |
} |
| 107 |
|
| 108 |
# fill map with "default" data - first region and first archetype from palette |
| 109 |
# used when we have no map data from elsewhere |
| 110 |
sub fill { |
| 111 |
my ($self) = @_; |
| 112 |
|
| 113 |
if ($self->{z} > 0) { |
| 114 |
# hmmm... air? :) |
| 115 |
$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]); |
| 116 |
} elsif ($self->{z} < 0) { |
| 117 |
$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]); |
| 118 |
} else { |
| 119 |
$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["deep_sea"]); |
| 120 |
} |
| 121 |
} |
| 122 |
|
| 123 |
sub load { |
| 124 |
my ($self) = @_; |
| 125 |
|
| 126 |
if ($self->{load_path}) { |
| 127 |
$self->SUPER::load; |
| 128 |
} else { |
| 129 |
$self->alloc; |
| 130 |
$self->fill; |
| 131 |
$self->in_memory (cf::MAP_ACTIVE); |
| 132 |
$self->activate; |
| 133 |
} |
| 134 |
} |
| 135 |
|
| 136 |
# MUST be overwritten to call at least ->fill |
| 137 |
sub post_load { |
| 138 |
my ($self) = @_; |
| 139 |
|
| 140 |
$self->create_region_treasure |
| 141 |
if delete $self->{need_create_treasure}; |
| 142 |
} |
| 143 |
|
