root/veekun/trunk/script/create_downloads.pl @ 248

#!/usr/bin/perl

use strict;
use warnings;
use File::Basename;
use File::Spec;
use File::Temp qw/tempfile/;
use YAML;

# usage: create_downloads.pl

my (undef, $path) = fileparse( File::Spec->rel2abs($0) );
my $basepath = File::Spec->rel2abs( $path . '/..' );
chdir $basepath;

my ($fh, $tempfile) = tempfile;

sub montage;
sub tarball;

# THAT'S CALLED A MONTAGE...  MONTAAAGE~
montage "green/%03d.png",       "montage-green.png",        60, 151;
montage "redblue/%03d.png",     "montage-redblue.png",      60, 151;
montage "yellow/%03d.png",      "montage-yellow.png",       60, 151;
montage "oldback/%03d.png",     "montage-rby-back.png",     60, 151;

montage "gold/%03d.png",        "montage-gold.png",         60, 251;
montage "silver/%03d.png",      "montage-silver.png",       60, 251;
montage "gold/shiny/%03d.png",  "montage-gold-shiny.png",   60, 251;
montage "silver/shiny/%03d.png","montage-silver-shiny.png", 60, 251;
montage "newback/%03d.png",     "montage-gsc-back.png",     60, 251;

montage "frlg/%03d.png",        "montage-frlg.png",         64, 151;
montage "rusa/%03d.png",        "montage-rusa.png",         64, 386;
montage "rusa/shiny/%03d.png",  "montage-rusa-shiny.png",   64, 386;
montage "rusaback/%03d.png",    "montage-rusa-back.png",    64, 386;

montage "dp/%03d.png",          "montage-dp.png",           80, 493;
montage "dp/frame2/%03d.png",   "montage-dp-frame2.png",    80, 493;
montage "dp/shiny/%03d.png",    "montage-dp-shiny.png",     80, 493;
montage "dp/back/%03d.png",     "montage-dp-back.png",      80, 493;
montage "dp/%03df.png",         "montage-dp-female.png",    80, 493;

# TODO: undupe this code.  like, next time you touch this.  yeah.  then.
if (-e "root/files/sprites/montage-berries.png") {
    print "montage-berries.png exists; skipping.\n";
} else {
    print "Generating montage-berries.png...\n";

    chdir 'root/dex-images/items/big';
    my @berries = glob('*-berry.png');
    my @berry_params;
    for my $file (@berries) {
        (my $berry = $file) =~ s/-berry\.png$//;
        push @berry_params, '-label', ucfirst $berry, $file;
    }
    system montage =>
        '-geometry', '+4+4',
        @berry_params,
        "png:$tempfile";
    chdir $basepath;

    print "Crushing...\n";

    system pngcrush => '-q',
        $tempfile => 'root/files/sprites/montage-berries.png';

    print "Done.\n";
}

if (-e "root/files/sprites/montage-items.png") {
    print "montage-items.png exists; skipping.\n";
} else {
    print "Generating montage-items.png...\n";

    my @files = glob('root/dex-images/items/*.png');
    my $cols = int(sqrt(scalar @files) / 5 + 1) * 5;

    system montage =>
        '-geometry' => '+0+0',
        '-tile' => $cols . 'x',
        'root/dex-images/items/*.png',
        "png:$tempfile";
    chdir $basepath;

    print "Crushing...\n";

    system pngcrush => '-q',
        $tempfile => 'root/files/sprites/montage-items.png';

    print "Done.\n";
}
# even Rocky had a montage...


# I don't have a funny movie quote for tarballs.
# Teehee.  Balls.
tarball items => 'root/dex-images/items', qw/ *.png rsefl /;
tarball rby => 'root/dex-images', qw/ redblue yellow oldback /;
tarball gsc => 'root/dex-images', qw/ gold silver crystal newback /;
tarball rse => 'root/dex-images', qw/ rusa rusaback emerald frlg /;
tarball dp  => 'root/dex-images', qw/ dp /;
tarball pawprints => 'root/dex-images/footpaws', '*.png';
tarball berries => 'root/dex-images/items/big', '*-berry.png';


# functions ahoy

sub montage {
    my ($pattern, $outfile, $size, $max) = @_;
    $pattern = "root/dex-images/$pattern";
    my $outpath = "root/files/sprites/$outfile";

    if (-e $outpath) {
        print "$outfile exists; skipping.\n";
        return;
    }

    print "Generating $outfile...\n";

    my @files =
        map { -e $_ ? $_ : 'null:' }
        map { sprintf $pattern, $_ }
        1 .. $max;

    # this will make the grid roughly square, width divisible by 5 and longer than height
    my $cols = int(sqrt($max) / 5 + 1) * 5;
    system montage =>
        '-geometry' => "${size}x${size}+0+0",  # since some females might be null
        '-tile'     => $cols . 'x',
        @files,
        "png:$tempfile";

    print "Crushing...\n";

    system pngcrush => '-q',
        $tempfile => $outpath;

    print "Done.\n";
}

sub dp_montage {
    my ($pattern, $outfile) = @_;
    montage("dp/$pattern", $outfile, 80, 493);
}

sub tarball {
    my ($outfile, $path, @files) = @_;
    my $outpath = File::Spec->rel2abs("$basepath/root/files/sprites/$outfile.tgz");

    if (-e $outpath) {
        print "$outfile.tgz exists; skipping.\n";
        return;
    }

    print "Generating $outfile.tgz...\n";

    # --force-local is required for absolute win32 path names; tar assumes
    # paths with colons are addresses on other machines
    chdir $path;
    system tar => '--force-local', '--exclude=.svn', '-czf', $outpath, @files;
    chdir $basepath;

    print "Done.\n";
}