1 |
#! perl # mandatory |
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 "%+04d", $_[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 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 |
) { |
56 |
$self->{ox} = $x - $meta->{x0}; |
57 |
$self->{oy} = $y - $meta->{y0}; |
58 |
$self->{oz} = $z - $meta->{z0}; |
59 |
|
60 |
bless $self, $meta->{pkg}; |
61 |
|
62 |
$self->init_worldmap ($meta); |
63 |
|
64 |
goto done; |
65 |
} |
66 |
} |
67 |
|
68 |
bless $self, ext::map_world::empty::; |
69 |
|
70 |
done: |
71 |
$self->SUPER::init; |
72 |
} |
73 |
|
74 |
sub init_worldmap { |
75 |
# only for handlers |
76 |
} |
77 |
|
78 |
sub load_header_orig { |
79 |
my ($self) = @_; |
80 |
|
81 |
my ($x, $y, $z) = @$self{qw(x y z)}; |
82 |
|
83 |
$self->width ($TILE_W); |
84 |
$self->height ($TILE_H); |
85 |
|
86 |
$self->name (sprintf "'The World' at %+d%+d%+d", $x, $y, $z); |
87 |
$self->msg ("worldmap dynamically created by map-world extension"); |
88 |
$self->outdoor ($self->{z} >= 0); |
89 |
$self->default_region (cf::region::find "wilderness"); |
90 |
|
91 |
# all possible worldmap tiles also exist |
92 |
$self->tile_path (cf::TILE_NORTH, format_xyz $x, $y - 1, $z); |
93 |
$self->tile_path (cf::TILE_SOUTH, format_xyz $x, $y + 1, $z); |
94 |
$self->tile_path (cf::TILE_EAST , format_xyz $x + 1, $y, $z); |
95 |
$self->tile_path (cf::TILE_WEST , format_xyz $x - 1, $y, $z); |
96 |
$self->tile_path (cf::TILE_UP , format_xyz $x, $y, $z + 1); |
97 |
$self->tile_path (cf::TILE_DOWN , format_xyz $x, $y, $z - 1); |
98 |
|
99 |
# an overlay always wins |
100 |
my $overlay = sprintf "%s/%s.map", $cf::MAPDIR, format_xyz $x, $y, $z; |
101 |
|
102 |
$self->{load_path} = $overlay |
103 |
unless Coro::AIO::aio_stat $overlay; |
104 |
|
105 |
$self->{need_create_treasure} = 1; |
106 |
|
107 |
1 |
108 |
} |
109 |
|
110 |
# fill map with "default" data - first region and first archetype from palette |
111 |
# used when we have no map data from elsewhere |
112 |
sub fill { |
113 |
my ($self) = @_; |
114 |
|
115 |
if ($self->{z} > 0) { |
116 |
# hmmm... air? :) |
117 |
$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]); |
118 |
} elsif ($self->{z} < 0) { |
119 |
$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["blocked"]); |
120 |
} else { |
121 |
$self->add_underlay ("\x00" x ($TILE_W * $TILE_H), 0, $TILE_W, ["deep_sea"]); |
122 |
} |
123 |
} |
124 |
|
125 |
#sub load { |
126 |
# my ($self) = @_; |
127 |
# |
128 |
# if ($self->{load_path}) { |
129 |
# warn "load $self\n";#d# |
130 |
# $self->SUPER::load; |
131 |
# } else { |
132 |
# warn "fill $self\n";#d# |
133 |
# my $guard = cf::lock_acquire "map_data:$self->{path}"; |
134 |
# |
135 |
# $self->alloc; |
136 |
# $self->fill; |
137 |
# $self->state (cf::MAP_ACTIVE); |
138 |
# $self->activate; |
139 |
# $self->post_load; |
140 |
# } |
141 |
#} |
142 |
|
143 |
# MUST be overwritten to call at least ->fill |
144 |
sub post_load { |
145 |
my ($self) = @_; |
146 |
|
147 |
$self->create_region_treasure |
148 |
if delete $self->{need_create_treasure}; |
149 |
} |
150 |
|
151 |
package ext::map_world::empty; |
152 |
|
153 |
our @ISA = ext::map_world::; |
154 |
|
155 |
sub post_load_original { |
156 |
$_[0]->fill; |
157 |
} |
158 |
|