#!/usr/bin/perl
#: tries to shrink a PNG by reducing its palette size.  The results are usually okay for not-photo images.
#======================================================================
# Last Modified Time-stamp: "2010-03-02 20:06:20 AKST sburke@cpan.org"

use constant DEBUG => 10;

use strict;
use warnings;

die "What input PNGs?" unless @ARGV;
# Yes, this OVERWRITES the source png, but backs it up.


foreach my $t (@ARGV) {
  die "$t doesn't exist!" unless -e $t;
  die "$t isn't readable!" unless -r $t;
  die "$t isn't writeable!" unless -w $t;
  die "$t isn't a file!" unless -w $t;
  die "$t isn't a png!" unless $t =~ m/\.png$/i;
}

my $temp = ($ENV{TMP} || $ENV{TEMP} || '.') . "/tidypng-$^T-$$.pnm";

foreach my $t (@ARGV) {
  my $qt = $t;

  #$qt =~ s/'/'\\''/g; #'"
  #$qt = "'$qt'";

  # Dumb shell quoting:
  $qt =~ s/([^._A-Za-z0-9])/\\$1/g; # just quote anything remodely odd

  do_cmd("pngtopnm $qt > $temp");
  my $old_size = -s $t;
  rename($t, "$t~");
  do_cmd("pnmquant 254 $temp | pnmtopng > $qt");
  unlink($temp);
  my $new_size = -s $t;
  
  printf "\n%s  %s => %s   (leaving %s~)\n", $t,
    commulate('',$old_size), commulate('',$new_size), $t;
}

sub do_cmd {
  my $cmd = $_[0];
  print "% $cmd\n";
  system($cmd) and die "Error during $cmd\nAborting";
}

sub commulate {
  # optimize for most common case:
  my($space, $i) = @_;
  while( $i =~ s/(\d)(\d\d\d)(\,|$)/${1},$2$3/g ) { }
  if(length $space) {
    my $c_count =  $i =~ tr/,//;
    $space = ' ' x (length($space) - $c_count);
  }
  return $space.$i;
}

__END__