#!/usr/bin/perl
# this is a program that puts individual png images into a large sheet.
use strict;
use warnings "all";
use GD;
{
my $spritesheetname = 'spritesheet.png';
# record the filename, width and height of all images
my @images;
while(<*.png>) {
if($_ ne $spritesheetname) {
my $im = GD::Image->newFromPng($_)
or warn "Unable to open $_";
$im->alphaBlending(0);
push @images, { 'width' => $im->width,
'height' => $im->height,
'x' => undef,
'y' => undef,
'filename' => $_,
'handle' => $im };
}
}
# determine offset values for tiling
my ($sheetwidth, $sheetheight) = tile(\@images);
# generate tiled sheet, write offsets to XML
my $spritesheet = GD::Image->new($sheetwidth, $sheetheight, 1)
or warn "Failed to create spritesheet, dimensions
$sheetwidth x $sheetheight";
# trying to make background transparent and make it get saved
$spritesheet->alphaBlending(0);
$spritesheet->saveAlpha(1);
my $transparent = $spritesheet->colorAllocateAlpha(0,0,0,127);
$spritesheet->filledRectangle(0, 0, $sheetwidth-1, $sheetheight-1, $transparent);
my $offsetsfile;
open $offsetsfile, '>', 'offsets.txt'
or warn 'Failed to open offsets file for writing';
foreach my $image (@images) {
$spritesheet->copy( @{$image}{'handle', 'x', 'y'},
0, 0,
@{$image}{'width', 'height'} );
# TODO output framesets
printf $offsetsfile '<Frame top="%d" left="%d" width="%d" height="%d" />' .
"<!-- %s -->\n",
@{$image}{'y', 'x', 'width', 'height', 'filename'};
}
my $sheetdata = $spritesheet->png;
my $sheetfile;
open $sheetfile, '>', $spritesheetname
or warn "Failed to open $spritesheetname for writing";
print $sheetfile $sheetdata;
close $sheetfile;
close $offsetsfile;
}
sub tile {
my $images = $_[0];
# This algorithm sorts the images by height, and then divide them into a few
# rows approximately equal in width. Every image is pushed as further up as
# possible, but for every second row, the images are placed by reverse height
# order, in order to decrease some space waste.
#
# To effectively save space, the images should be trimmed to remove whitespace
# on the borders. This algorithm works best when the widths of images are almost
# equal, and heights of images do not vary too much.
# this parameter decides the approximate number of rows in the sprite sheet
my $sheetrows = 8;
# sort the images by height
@$images = sort { $a->{'height'} <=> $b->{'height'} } @$images;
# determine the width of the tiled sheet
my $totalwidth = 0;
foreach my $image (@$images) {
$totalwidth += $image->{'width'};
}
my $sheetwidth = $totalwidth / $sheetrows;
# @bottomedges keeps track of end points of the lower edges of bottommost
# images. a long imaginary row above the top row is initialized
my @edgesabove = ( {'x' => $totalwidth, 'y' => 0} );
# the row number is kept track of so that every second row, the images can
# be reverse sorted by height
my $rownumber = 0;
my @row;
my $rowwidth = 0;
my $actualwidth = 0;
my $actualheight = 0;
# write offsets for each image
for(my $i = 0; $i < scalar @$images; ++$i) {
# add image to row
push @row, $images->[$i];
$images->[$i]->{'x'} = $rowwidth;
$rowwidth += $images->[$i]->{'width'};
if($rowwidth >= $sheetwidth || $i == scalar @$images - 1) {
# row is full, process the row
# reverse every second row (previously ordered by height)
if($rownumber++ % 2) { @row = reverse @row }
# determine y offsets for the row of images
my $columnabove = 0;
my @bottomedges;
foreach my $rowimage (@row) {
# find the edge above the image (i.e. the first edge to go beyond
# image's left edge)
while ($columnabove < scalar @edgesabove &&
$edgesabove[$columnabove]->{'x'} < $rowimage->{'x'})
{ ++$columnabove; }
# this edge determines the y offset for the image
$rowimage->{'y'} = $edgesabove[$columnabove]->{'y'};
push @bottomedges,
{ 'x' => $rowimage->{'x'} + $rowimage->{'width'},
'y' => $rowimage->{'y'} + $rowimage->{'height'} };
}
# update $actualwidth as the maximum $rowwidth
if($rowwidth > $actualwidth) { $actualwidth = $rowwidth; }
# update for next row
@edgesabove = @bottomedges;
@row = ();
$rowwidth = 0;
}
}
# find out #actualheight from last row
foreach my $point (@edgesabove) {
if($point->{'y'} > $actualheight) { $actualheight = $point->{'y'}; };
}
return ($actualwidth, $actualheight);
}