From 576f66c9fde876c86b20c3da21ce254cd3f3ba78 Mon Sep 17 00:00:00 2001
From: Mischa POSLAWSKY <perl@shiar.org>
Date: Thu, 12 Feb 2009 03:34:19 +0100
Subject: [PATCH] XXX: TileSet: imager

---
 Data-StarCraft/lib/Data/StarCraft/Tileset.pm | 62 ++++++++++++++------
 scmap                                        |  6 +-
 2 files changed, 44 insertions(+), 24 deletions(-)

diff --git a/Data-StarCraft/lib/Data/StarCraft/Tileset.pm b/Data-StarCraft/lib/Data/StarCraft/Tileset.pm
index f1fcd3e..1dc8d60 100644
--- 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 e5a2798..2787355 100755
--- 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}->[$_]);
-- 
2.30.0