94 lines
2.3 KiB
Perl
94 lines
2.3 KiB
Perl
package TextureAtlas;
|
|
|
|
# Incredibly rubbish texture packer
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Image::Magick;
|
|
|
|
sub new
|
|
{
|
|
my ($class, $width) = @_;
|
|
my $self = {
|
|
width => $width,
|
|
x => 0,
|
|
y => 0,
|
|
rowheight => 0,
|
|
images => {},
|
|
};
|
|
bless $self, $class;
|
|
}
|
|
|
|
sub add
|
|
{
|
|
my ($self, $filename) = @_;
|
|
return if $self->{images}{$filename};
|
|
|
|
my $img = new Image::Magick;
|
|
$img->ReadImage($filename);
|
|
my $w = $img->Get("width");
|
|
my $h = $img->Get("height");
|
|
|
|
if ($filename =~ /\.tga$/i) {
|
|
for my $y (0..$h-1) {
|
|
for my $x (0..$w-1) {
|
|
my @p = $img->GetPixel(x => $x, y => $y, channel => "RGBA");
|
|
if ($p[0] == $p[2] and $p[1] == 0) {
|
|
my $a = $p[0] * 1.5;
|
|
$a = 0.95 if $a > 0.95; # prevent premul ugliness
|
|
my $c = $a;
|
|
$img->SetPixel(x => $x, y => $y, color => [$c,$c,$c,$a], channel => "RGBA");
|
|
} else {
|
|
$img->SetPixel(x => $x, y => $y, color => [$p[0],$p[1],$p[2],0], channel => "RGBA");
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
die if $w > $self->{width};
|
|
if ($self->{x} + $w > $self->{width}) {
|
|
$self->{x} = 0;
|
|
$self->{y} += $self->{rowheight};
|
|
$self->{rowheight} = 0;
|
|
}
|
|
|
|
$self->{images}{$filename} = { img => $img, w => $w, h => $h, x => $self->{x}, y => $self->{y} };
|
|
|
|
$self->{rowheight} = $h if $h > $self->{rowheight};
|
|
$self->{x} += $w;
|
|
}
|
|
|
|
sub finish
|
|
{
|
|
my ($self, $filename) = @_;
|
|
|
|
my $h = $self->{y} + $self->{rowheight};
|
|
my $hlog = log($h)/log(2);
|
|
$hlog = int($hlog+1) if $hlog != int($hlog);
|
|
$h = 2**$hlog;
|
|
$self->{height} = $h;
|
|
|
|
my $image = new Image::Magick;
|
|
$image->Set(size => $self->{width}."x".$h, depth => 8);
|
|
$image->ReadImage("xc:transparent");
|
|
for my $t (values %{ $self->{images} }) {
|
|
$image->Composite(image => $t->{img}, x => $t->{x}, y => $t->{y});
|
|
}
|
|
$image->Write($filename);
|
|
}
|
|
|
|
sub get_texcoords
|
|
{
|
|
my ($self, $filename) = @_;
|
|
my $t = $self->{images}{$filename} or die;
|
|
return (
|
|
$t->{x} / $self->{width},
|
|
1 - ($t->{y} / $self->{height}),
|
|
($t->{x} + $t->{w}) / $self->{width},
|
|
1 - (($t->{y} + $t->{h}) / $self->{height}),
|
|
);
|
|
}
|
|
|
|
1;
|