git.shiar.nl
/
perl
/
schtarr.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
XXX: scmap: restore metadata marking (era-dependant styling)
[perl/schtarr.git]
/
Data-StarCraft
/
lib
/
Data
/
StarCraft
/
Tileset.pm
diff --git
a/Data-StarCraft/lib/Data/StarCraft/Tileset.pm
b/Data-StarCraft/lib/Data/StarCraft/Tileset.pm
index 891c12b93c5ae96f48792f06ae6b27ea17f81018..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 strict;
use warnings;
+use Carp;
use Data::Dumper;
use List::Util qw(sum);
use Data::Dumper;
use List::Util qw(sum);
-our $VERSION = '0.1
0
';
+our $VERSION = '0.1
1
';
sub open {
my ($class, $filename) = @_;
sub open {
my ($class, $filename) = @_;
@@
-107,7
+108,7
@@
Average color [r,g,b] for minitile.
For example, using the Jungle tileset:
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]>.
is a water minitile, giving a blue color C<[38, 38, 57]>.
@@
-117,7
+118,8
@@
sub sprite {
my $self = shift;
my ($id) = @_;
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) {
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
=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) = @_;
sub tile {
my $self = shift;
my ($id) = @_;
@@
-154,10
+191,8
@@
sub tile {
return {
id => $tile,
group => $self->{group}->[$id >> 4],
return {
id => $tile,
group => $self->{group}->[$id >> 4],
-# subtype => [ map { $self->{minitype}->[$_] } @$minitiles ],
subtype => [ map { $self->{minitype}->[$_] } $tile*16 .. $tile*16+15 ],
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,11
+202,7
@@
sub tileavg {
my $info = $tile->{group};
$info->{walk} = sum(@{ $tile->{subtype} }) >> 4;
my $info = $tile->{group};
$info->{walk} = sum(@{ $tile->{subtype} }) >> 4;
- my @rgb;
- for my $subcol (@{ $tile->{subcol} }) {
- $rgb[$_] += $subcol->[$_] for 0 .. 2;
- }
- $info->{col} = [ map {$_ >> 4} @rgb ];
+ $info->{col} = $self->colavg($tile->{sprite});
return $info;
}
return $info;
}
@@
-189,12
+220,7
@@
would give:
build => 128,
},
subtype => [ 1,1,1,1, 1,1,1,1, 1,1,1,1, 1,1,1,1 ],
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
=cut