1 |
root |
1.43 |
#! perl # mandatory |
2 |
root |
1.1 |
|
3 |
root |
1.41 |
# 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 |
root |
1.23 |
}; |
21 |
root |
1.41 |
|
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 |
root |
1.42 |
for my $meta (@AREAS) { |
52 |
|
|
if ( $meta->{x0} <= $x && $x <= $meta->{x1} |
53 |
|
|
&& $meta->{y0} <= $y && $y <= $meta->{y1} |
54 |
|
|
&& $meta->{z0} <= $z && $z <= $meta->{z1} |
55 |
root |
1.41 |
) { |
56 |
root |
1.42 |
$self->{ox} = $x - $meta->{x0}; |
57 |
|
|
$self->{oy} = $y - $meta->{y0}; |
58 |
|
|
$self->{oz} = $z - $meta->{z0}; |
59 |
root |
1.41 |
|
60 |
root |
1.42 |
bless $self, $meta->{pkg}; |
61 |
root |
1.41 |
|
62 |
root |
1.42 |
$self->init_worldmap ($meta); |
63 |
root |
1.41 |
|
64 |
|
|
last; |
65 |
|
|
} |
66 |
|
|
|
67 |
|
|
} |
68 |
|
|
|
69 |
|
|
$self->SUPER::init; |
70 |
root |
1.35 |
} |
71 |
root |
1.8 |
|
72 |
root |
1.41 |
sub init_worldmap { |
73 |
|
|
# only for handlers |
74 |
root |
1.1 |
} |
75 |
|
|
|
76 |
|
|
sub load_header_orig { |
77 |
|
|
my ($self) = @_; |
78 |
|
|
|
79 |
root |
1.41 |
my ($x, $y, $z) = @$self{qw(x y z)}; |
80 |
root |
1.1 |
|
81 |
root |
1.40 |
$self->width ($TILE_W); |
82 |
|
|
$self->height ($TILE_H); |
83 |
root |
1.3 |
|
84 |
root |
1.41 |
$self->name (sprintf "'The World' at %+d%+d%+d", $x, $y, $z); |
85 |
root |
1.1 |
$self->msg ("worldmap dynamically created by map-world extension"); |
86 |
root |
1.41 |
$self->outdoor ($self->{z} >= 0); |
87 |
root |
1.20 |
$self->default_region (cf::region::find "wilderness"); |
88 |
root |
1.1 |
|
89 |
root |
1.41 |
# 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 |
root |
1.7 |
|
97 |
root |
1.41 |
# an overlay always wins |
98 |
|
|
my $overlay = sprintf "%s/%s.map", $cf::MAPDIR, format_xyz $x, $y, $z; |
99 |
root |
1.28 |
|
100 |
|
|
$self->{load_path} = $overlay |
101 |
|
|
unless Coro::AIO::aio_stat $overlay; |
102 |
root |
1.1 |
|
103 |
root |
1.24 |
$self->{need_create_treasure} = 1; |
104 |
|
|
|
105 |
root |
1.1 |
1 |
106 |
|
|
} |
107 |
|
|
|
108 |
root |
1.41 |
# fill map with "default" data - first region and first archetype from palette |
109 |
|
|
# used when we have no map data from elsewhere |
110 |
root |
1.13 |
sub fill { |
111 |
|
|
my ($self) = @_; |
112 |
|
|
|
113 |
root |
1.41 |
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 |
root |
1.13 |
} |
122 |
|
|
|
123 |
root |
1.43 |
#sub load { |
124 |
|
|
# my ($self) = @_; |
125 |
|
|
# |
126 |
|
|
# if ($self->{load_path}) { |
127 |
|
|
# warn "load $self\n";#d# |
128 |
|
|
# $self->SUPER::load; |
129 |
|
|
# } else { |
130 |
|
|
# warn "fill $self\n";#d# |
131 |
|
|
# my $guard = cf::lock_acquire "map_data:$self->{path}"; |
132 |
|
|
# |
133 |
|
|
# $self->alloc; |
134 |
|
|
# $self->fill; |
135 |
|
|
# $self->in_memory (cf::MAP_ACTIVE); |
136 |
|
|
# $self->activate; |
137 |
|
|
# $self->post_load; |
138 |
|
|
# } |
139 |
|
|
#} |
140 |
root |
1.1 |
|
141 |
root |
1.41 |
# MUST be overwritten to call at least ->fill |
142 |
root |
1.3 |
sub post_load { |
143 |
root |
1.1 |
my ($self) = @_; |
144 |
|
|
|
145 |
root |
1.26 |
$self->create_region_treasure |
146 |
|
|
if delete $self->{need_create_treasure}; |
147 |
root |
1.1 |
} |
148 |
|
|
|