| 1 |
#! perl # OPTIONAL |
| 2 |
|
| 3 |
# optional plug-in to speed up worldmap rendering by dynamically |
| 4 |
# generating it out of a image |
| 5 |
# - saves loading time (less data to read) |
| 6 |
# - saves temporary space (only overlay stuff needs to be saved) |
| 7 |
|
| 8 |
our $WORLD = Storable::retrieve cf::datadir . "/world.pst" |
| 9 |
or die "unable to load world.pst"; |
| 10 |
|
| 11 |
$WORLD->{version} == 1 |
| 12 |
or die "world.pst version mismatch, expected version 1, got $WORLD->{version}"; |
| 13 |
|
| 14 |
cf::map->register (qr{^/world/world_(\d\d\d)_(\d\d\d)$}, 100); |
| 15 |
|
| 16 |
sub init { |
| 17 |
my ($self) = @_; |
| 18 |
|
| 19 |
1 |
| 20 |
} |
| 21 |
|
| 22 |
sub wxwy { |
| 23 |
$_[0]->path =~ m{/world/world_(\d\d\d)_(\d\d\d)$} |
| 24 |
? ($1, $2) |
| 25 |
: (0, 0) |
| 26 |
} |
| 27 |
|
| 28 |
sub load_header_orig { |
| 29 |
my ($self) = @_; |
| 30 |
|
| 31 |
$self->width ($WORLD->{tilew}); |
| 32 |
$self->height ($WORLD->{tileh}); |
| 33 |
|
| 34 |
my ($x, $y) = $self->wxwy; |
| 35 |
|
| 36 |
$self->tile_path (0, sprintf "/world/world_%03d_%03d", $x, $y - 1) if $y > 0; |
| 37 |
$self->tile_path (1, sprintf "/world/world_%03d_%03d", $x + 1, $y) if $x < 999; |
| 38 |
$self->tile_path (2, sprintf "/world/world_%03d_%03d", $x, $y + 1) if $y < 999; |
| 39 |
$self->tile_path (3, sprintf "/world/world_%03d_%03d", $x - 1, $y) if $x > 0; |
| 40 |
|
| 41 |
$self->outdoor (1); |
| 42 |
|
| 43 |
$self->name ("'The World' at +$x+$y"); |
| 44 |
$self->msg ("worldmap dynamically created by map-world extension"); |
| 45 |
|
| 46 |
#TODO: region |
| 47 |
|
| 48 |
$self->{load_path} = sprintf "%s/%s/world-overlay/world_%03d_%03d", cf::datadir, cf::mapdir, $x, $y |
| 49 |
if $x >= $WORLD->{minx} && $x <= $WORLD->{maxx} |
| 50 |
&& $y >= $WORLD->{miny} && $y <= $WORLD->{maxy}; |
| 51 |
|
| 52 |
|
| 53 |
1 |
| 54 |
} |
| 55 |
|
| 56 |
sub load { |
| 57 |
my ($self) = @_; |
| 58 |
|
| 59 |
if ($self->{load_path}) { |
| 60 |
$self->SUPER::load; |
| 61 |
} else { |
| 62 |
$self->alloc; |
| 63 |
|
| 64 |
for my $X (0 .. $WORLD->{tilew} - 1) { |
| 65 |
Coro::cede; |
| 66 |
for my $Y (0 .. $WORLD->{tileh} - 1) { |
| 67 |
my $ob = cf::object::new "deep_sea"; |
| 68 |
$self->insert ($ob, $X, $Y); |
| 69 |
} |
| 70 |
} |
| 71 |
$self->set_object_flag (cf::FLAG_NO_MAP_SAVE, 1); |
| 72 |
|
| 73 |
$self->in_memory (cf::MAP_IN_MEMORY); |
| 74 |
} |
| 75 |
} |
| 76 |
|
| 77 |
sub post_load { |
| 78 |
my ($self) = @_; |
| 79 |
|
| 80 |
my ($x, $y) = $self->wxwy; |
| 81 |
|
| 82 |
return |
| 83 |
unless $x >= $WORLD->{minx} && $x <= $WORLD->{maxx} |
| 84 |
&& $y >= $WORLD->{miny} && $y <= $WORLD->{maxy}; |
| 85 |
|
| 86 |
my $stride = ($WORLD->{maxx} - $WORLD->{minx} + 1) * $WORLD->{tilew}; |
| 87 |
my $top = ($y - $WORLD->{miny}) * $WORLD->{tileh} * $stride |
| 88 |
+ ($x - $WORLD->{minx}) * $WORLD->{tilew}; |
| 89 |
|
| 90 |
for my $Y (0 .. $WORLD->{tileh} - 1) { |
| 91 |
Coro::cede; |
| 92 |
my $row = substr $WORLD->{data}, $top + $Y * $stride, $WORLD->{tilew}; |
| 93 |
for my $X (0 .. $WORLD->{tilew} - 1) { |
| 94 |
next if grep $_->flag (cf::FLAG_IS_FLOOR), $self->at ($X, $Y); |
| 95 |
my $ob = cf::object::new $WORLD->{arch}[ord substr $row, $X]; |
| 96 |
$ob->flag (cf::FLAG_NO_MAP_SAVE, 1); |
| 97 |
$self->insert ($ob, $X, $Y, undef, cf::INS_ABOVE_FLOOR_ONLY); |
| 98 |
} |
| 99 |
} |
| 100 |
} |
| 101 |
|
| 102 |
1 |
| 103 |
|
