XXX: TileSet: imager

diff --git a/Data-StarCraft/lib/Data/StarCraft/Tileset.pm b/Data-StarCraft/lib/Data/StarCraft/Tileset.pm
index f1fcd3e2ce0182c404b220b594dcdb49cefe63a4..1dc8d60ea30aa5b9dbf9dd8fdb87900e143ab035 100644 (file)
--- a/Data-StarCraft/lib/Data/StarCraft/Tileset.pm
+++ b/Data-StarCraft/lib/Data/StarCraft/Tileset.pm
@@ -2,11 +2,12 @@ package Data::StarCraft::Tileset;
 
 use strict;
 use warnings;
+use Carp;
 use Data::Dumper;
 
 use List::Util qw(sum);
 
-our $VERSION = '0.10';
+our $VERSION = '0.11';
 
 sub open {
        my ($class, $filename) = @_;
@@ -107,7 +108,7 @@ Average color [r,g,b] for minitile.
 
 For example, using the Jungle tileset:
 
-       $t->col(719)
+       my @rgb = $t->col(719)
 
 is a water minitile, giving a blue color C<[38, 38, 57]>.
 
@@ -117,7 +118,8 @@ sub sprite {
        my $self = shift;
        my ($id) = @_;
 
-       my $minitiles = $self->{tileref}->[$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) {
@@ -145,6 +147,41 @@ For example, the green value of the bottom center pixel of tile #1 would be:
 
 =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) = @_;
@@ -154,10 +191,8 @@ sub tile {
        return {
                id => $tile,
                group   => $self->{group}->[$id >> 4],
-#              subtype => [ map { $self->{minitype}->[$_] } @$minitiles ],
                subtype => [ map { $self->{minitype}->[$_] } $tile*16 .. $tile*16+15 ],
-               subcol  => [ map { $self->col($_ >> 1) } @$minitiles ],
-#              sprite  => $self->sprite($tile),
+               sprite  => $self->tileimg( [ map { @{ $self->col($_ >> 1) } } @$minitiles ] ),
        };
 }
 
@@ -167,13 +202,7 @@ sub tileavg {
 
        my $info = $tile->{group};
        $info->{walk} = sum(@{ $tile->{subtype} }) >> 4;
-       my @rgb;
-       for my $subcol (@{ $tile->{subcol} }) {
-               $rgb[0] += $subcol->[0];
-               $rgb[1] += $subcol->[1]; # seperate for speed
-               $rgb[2] += $subcol->[2];
-       }
-       $info->{col} = [ map {$_ >> 4} @rgb ];
+       $info->{col} = $self->colavg($tile->{sprite});
        return $info;
 }
 
@@ -191,12 +220,7 @@ would give:
                build  => 128,
        },
        subtype => [ 1,1,1,1, 1,1,1,1, 1,1,1,1, 1,1,1,1 ],
-       subcol => [
-               [39,40,59], [38,39,57], [40,41,60], [36,37,55],
-               [37,38,56], [39,40,60], [38,39,57], [40,41,61],
-               [37,38,56], [41,41,61], [40,40,60], [36,36,54],
-               [36,36,54], [37,37,55], [35,35,53], [38,38,57]
-       ],
+       sprite => Imager->new(4, 4, 3),
 
 =cut
 

diff --git a/scmap b/scmap
index e5a2798665d04d132b23f200632b14902b88005b..2787355bd25d81bd784a4aa8e3bc3492320405a9 100755 (executable)
--- a/scmap
+++ b/scmap
@@ -89,11 +89,7 @@ if (defined $mapsep{$SHOWMAP}) {
 
                        # 512x512 ~ 7s
                        my $tile = $tileset->tile($_);
-                       $img->setscanline(
-                               x => $x*4, y => $y*4 + $_, pixels => pack('(CCCx)*',
-                                       map { @$_ } @{ $tile->{subcol} }[$_*4 .. $_*4 + 3]
-                               ),
-                       ) for 0..3;
+                       $img->paste(src => $tile->{sprite}, left => $x*4, top => $y*4);
 
                        # 4096x4096 ~ 75s
 #                      my $tile = $tileset->sprite($tileset->{map}->[$_]);