#!/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'; tarball cries => 'root/files/cries', '*.mp3'; # 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 $subfolder = 'sprites'; if ($outfile eq 'cries') { # Hack $subfolder = 'cries'; } my $outpath = File::Spec->rel2abs("$basepath/root/files/$subfolder/$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; @files = map { glob $_ } @files; # on Linux expansion is done by the shell system tar => '--force-local', '--exclude=.svn', '-czf', $outpath, @files; chdir $basepath; print "Done.\n"; }