All pastes #279101 Raw Edit

gd alpha problem

public text v1 · immutable
·published 2006-12-14 18:25 UTC
rendered paste body
#!/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);
}