1 package Data::StarCraft::Tileset;
8 use List::Util qw(sum);
10 our $VERSION = '0.11';
13 my ($class, $filename) = @_;
14 my $self = bless {}, $class;
15 open my $groupfile, '<', "$filename.cv5" or return;
16 $self->readgroups($groupfile);
17 if (open my $groupfile, '<', "$filename.vx4") {
18 $self->readvx4($groupfile);
20 if (open my $groupfile, '<', "$filename.vf4") {
21 $self->readvf4($groupfile);
23 if (open my $groupfile, '<', "$filename.vr4") {
24 $self->readvr4($groupfile);
26 if (open my $groupfile, '<', "$filename.wpe") {
27 $self->readwpe($groupfile);
34 my ($fh, $size, $seek) = @_;
36 seek $fh, $seek, 0 if $seek;
37 read($fh, my $in, $size) eq $size or return undef;
46 while (defined (my $line = $self->_read($fh, 4))) {
47 push @{ $self->{palette} }, [ unpack 'CCCX', $line ];
56 # vx4 = minitile map (4x4 references per megatile)
57 while (defined (my $line = $self->_read($fh, 16*2))) {
58 push @{ $self->{tileref} }, [ unpack 'v*', $line ];
67 # vr4 = minitile sprites
68 while (defined (my $line = $self->_read($fh, 8**2))) {
69 push @{ $self->{minibmp} }, [ unpack 'C*', $line ];
79 while (defined (my $line = $self->_read($fh, 2))) {
80 push @{ $self->{minitype} }, unpack 'v', $line;
89 return $self->{bmp}->[$minitile] if defined $self->{bmp}->[$minitile];
91 my $pixels = $self->{minibmp}->[$minitile];
92 my $pal = $self->{palette};
95 for my $color (@$pixels) {
96 # $rgb[$_] += $self->{palette}->[$color]->[$_] for 0 .. 2;
97 # # ^ wow, this is really slow
98 $rgb[0] += $pal->[$color]->[0];
99 $rgb[1] += $pal->[$color]->[1];
100 $rgb[2] += $pal->[$color]->[2];
102 return $self->{bmp}->[$minitile] = [map {$_ >> 6} @rgb];
107 Average color [r,g,b] for minitile.
109 For example, using the Jungle tileset:
111 my @rgb = $t->col(719)
113 is a water minitile, giving a blue color C<[38, 38, 57]>.
121 my $minitiles = $self->{tileref}->[$id]
122 or croak "tile ref $id does not exist";
124 for my $tiley (0 .. 3) {
126 for my $tilex (0 .. 3) {
127 # minitile number is half of tileref
128 # if odd, the minitile is mirrored
129 my $minitile = $minitiles->[$tilex + $tiley*4];
131 for my $x ($minitile & 1 ? (reverse 0 .. 7) : (0 .. 7)) {
132 push @pix, $self->{minibmp}->[$minitile >> 1]->[$x + $y*8];
142 Returns bitmap of an entire tile, as 32x32 color indexes.
144 For example, the green value of the bottom center pixel of tile #1 would be:
146 $t->{palette}->[ $t->sprite(1)->[31*32 + 15] ]->[2]
150 use Inline with => 'Imager';
151 use Inline C => <<'EOS';
152 Imager tileimg(SV* self, AV* tiledata) {
153 Imager img = i_img_8_new(4, 4, 3);
156 for (bit = 0; bit < 4 * 4 * 3; ++bit) {
157 SV **bitval = av_fetch(tiledata, bit, 0);
158 if (bitval && SvOK(*bitval))
159 img->idata[bit] = (int)SvIV(*bitval);
165 SV* colavg(SV* self, Imager img) {
170 for (pixel = 0; pixel < 4 * 4; ++pixel) {
171 for (ch = 0; ch < 3; ++ch) {
172 rgb[ch] += img->idata[pixel*3 + ch];
176 AV* perlrgb = newAV();
177 for (ch = 0; ch < 3; ++ch) {
178 av_push(perlrgb, newSViv(rgb[ch] >> 4));
180 return newRV_noinc(perlrgb);
189 my $tile = $self->{map}->[$id];
190 my $minitiles = $self->{tileref}->[$tile] || [];
193 group => $self->{group}->[$id >> 4],
194 subtype => [ map { $self->{minitype}->[$_] } $tile*16 .. $tile*16+15 ],
195 sprite => $self->tileimg( [ map { @{ $self->col($_ >> 1) } } @$minitiles ] ),
201 my $tile = $self->tile(shift);
203 my $info = $tile->{group};
204 $info->{walk} = sum(@{ $tile->{subtype} }) >> 4;
205 $info->{col} = $self->colavg($tile->{sprite});
211 Tile details. For example a water tile:
222 subtype => [ 1,1,1,1, 1,1,1,1, 1,1,1,1, 1,1,1,1 ],
223 sprite => Imager->new(4, 4, 3),
233 while (defined (my $line = $self->_read($fh, 52))) {
234 my @data = unpack "vCC v24", $line;
236 build => $data[1] & 0xF0,
237 height => $data[2] & 0xF,
238 # rawdata => [@data[0..10]],
240 push @{ $self->{group} }, \%row;
241 push @{ $self->{map} }, $_ for @data[11..26];
244 # index (ground_height unknown4 buildable unknown3) u6 u7 u8 u9 u10 u11 u12 u13
245 # 1 (ground_height unknown4 buildable unknown3) 35 0 doodad_group 0 58 6 6 0