+sub readwpe {
+ my $self = shift;
+ my ($fh) = @_;
+
+ # wpe = palette
+ while (defined (my $line = $self->_read($fh, 4))) {
+ push @{ $self->{palette} }, [ unpack 'CCCX', $line ];
+ }
+ return;
+}
+
+sub readvx4 {
+ my $self = shift;
+ my ($fh) = @_;
+
+ # vx4 = minitile map (4x4 references per megatile)
+ while (defined (my $line = $self->_read($fh, 16*2))) {
+ push @{ $self->{tileref} }, [ unpack 'v*', $line ];
+ }
+ return;
+}
+
+sub readvr4 {
+ my $self = shift;
+ my ($fh) = @_;
+
+ # vr4 = minitile sprites
+ while (defined (my $line = $self->_read($fh, 8**2))) {
+ push @{ $self->{minibmp} }, [ unpack 'C*', $line ];
+ }
+ return;
+}
+
+sub readvf4 {
+ my $self = shift;
+ my ($fh) = @_;
+
+ # vf4 = minitile type
+ while (defined (my $line = $self->_read($fh, 2))) {
+ push @{ $self->{minitype} }, unpack 'v', $line;
+ }
+ return;
+}
+
+sub col {
+ my $self = shift;
+ my ($minitile) = @_;
+
+ return $self->{bmp}->[$minitile] if defined $self->{bmp}->[$minitile];
+
+ my $pixels = $self->{minibmp}->[$minitile];
+ my $pal = $self->{palette};
+
+ my @rgb;
+ for my $color (@$pixels) {
+# $rgb[$_] += $self->{palette}->[$color]->[$_] for 0 .. 2;
+# # ^ wow, this is really slow
+ $rgb[0] += $pal->[$color]->[0];
+ $rgb[1] += $pal->[$color]->[1];
+ $rgb[2] += $pal->[$color]->[2];
+ }
+ return $self->{bmp}->[$minitile] = [map {$_ >> 6} @rgb];
+}
+
+=head2 col
+
+Average color [r,g,b] for minitile.
+
+For example, using the Jungle tileset:
+
+ my @rgb = $t->col(719)
+
+is a water minitile, giving a blue color C<[38, 38, 57]>.
+
+=cut
+
+sub sprite {
+ my $self = shift;
+ my ($id) = @_;
+
+ my $minitiles = $self->{tileref}->[$id]
+ or croak "tile ref $id does not exist";
+ my @pix;
+ for my $tiley (0 .. 3) {
+ for my $y (0 .. 7) {
+ for my $tilex (0 .. 3) {
+ # minitile number is half of tileref
+ # if odd, the minitile is mirrored
+ my $minitile = $minitiles->[$tilex + $tiley*4];
+
+ for my $x ($minitile & 1 ? (reverse 0 .. 7) : (0 .. 7)) {
+ push @pix, $self->{minibmp}->[$minitile >> 1]->[$x + $y*8];
+ }
+ }
+ }
+ }
+ return \@pix;
+}
+
+=head2 sprite
+
+Returns bitmap of an entire tile, as 32x32 color indexes.
+
+For example, the green value of the bottom center pixel of tile #1 would be:
+
+ $t->{palette}->[ $t->sprite(1)->[31*32 + 15] ]->[2]
+
+=cut
+
+use Inline with => 'Imager';
+use Inline C => <<'EOS';
+Imager tileimg(SV* self, AV* tiledata) {
+ Imager img = i_img_8_new(4, 4, 3);
+
+ int bit;
+ for (bit = 0; bit < 4 * 4 * 3; ++bit) {
+ SV **bitval = av_fetch(tiledata, bit, 0);
+ if (bitval && SvOK(*bitval))
+ img->idata[bit] = (int)SvIV(*bitval);
+ }
+
+ return img;
+}
+
+SV* colavg(SV* self, Imager img) {
+ int ch;
+ int pixel;
+ int rgb[3];
+
+ for (pixel = 0; pixel < 4 * 4; ++pixel) {
+ for (ch = 0; ch < 3; ++ch) {
+ rgb[ch] += img->idata[pixel*3 + ch];
+ }
+ }
+
+ AV* perlrgb = newAV();
+ for (ch = 0; ch < 3; ++ch) {
+ av_push(perlrgb, newSViv(rgb[ch] >> 4));
+ }
+ return newRV_noinc(perlrgb);
+}
+
+EOS
+
+sub tile {
+ my $self = shift;
+ my ($id) = @_;
+
+ my $tile = $self->{map}->[$id];
+ my $minitiles = $self->{tileref}->[$tile] || [];
+ return {
+ id => $tile,
+ group => $self->{group}->[$id >> 4],
+ subtype => [ map { $self->{minitype}->[$_] } $tile*16 .. $tile*16+15 ],
+ sprite => $self->tileimg( [ map { @{ $self->col($_ >> 1) } } @$minitiles ] ),
+ };
+}
+
+sub tileavg {
+ my $self = shift;
+ my $tile = $self->tile(shift);
+
+ my $info = $tile->{group};
+ $info->{walk} = sum(@{ $tile->{subtype} }) >> 4;
+ $info->{col} = $self->colavg($tile->{sprite});
+ return $info;
+}
+
+=head2 tile
+
+Tile details. For example a water tile:
+
+ $t->tile(96)
+
+would give:
+
+ group => {
+ walk => 0,
+ height => 0,
+ build => 128,
+ },
+ subtype => [ 1,1,1,1, 1,1,1,1, 1,1,1,1, 1,1,1,1 ],
+ sprite => Imager->new(4, 4, 3),
+
+=cut
+