Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 144 lines (115 sloc) 3.26 KB
#!/usr/bin/perl -w # -*- perl -*-
#
# gifsplash (bin/gifsplash)
#
# This script explodes the set of black images distributed with the
# Template Toolkit (images/splash/black/*) into the colours specified
# in the html/rgb template (templates/html/rgb). It is run at "make
# install" time and operates on the TT2 installation directory. Note
# that the main loop runs in template space where there is convenient
# access to the RGB definitions.
#
#
use strict;
use Template;
use Getopt::Std;
my $PROGRAM = 'gifsplash';
my $VERSION = 0.03;
my $MASKDIR = 'black';
my $args = { };
getopts('vs:d:i:h', $args);
usage() if $args->{ h };
my ($verbose, $src, $dest, $inst) = @$args{ qw( v s d i ) };
$inst ||= Template::Config->instdir()
|| die "Cannot determine Template Toolkit installation directory\n";
$src ||= "$inst/images/splash/$MASKDIR";
$dest ||= "$inst/images/splash";
if ($verbose) {
print STDERR <<EOF;
Weaving the rainbow: blowing colour into Splash! GIFs
src: $src
dest: $dest/*
EOF
}
my $tt = Template->new(
INCLUDE_PATH => "$inst/templates",
PRE_PROCESS => 'html/rgb',
OUTPUT_PATH => $dest,
) || die Template->error(), "\n";
my $vars = {
gifs => load_gifs($src),
colour => \&colour_gif,
verbose => $verbose,
};
my $out;
$tt->process(\*DATA, $vars, \$out)
|| die $tt->error(), "\n";
#------------------------------------------------------------------------
sub load_gifs {
my $gifdir = shift;
my (@files, $gifs);
local (*DIR, *GIF);
local $" = ', ';
local $/ = undef;
opendir(DIR, $gifdir) || die "$gifdir: $!";
@files = grep { /\.gif$/ } readdir(DIR);
closedir DIR;
if ($verbose) {
my $filenames = '';
my @tmpfiles = @files;
while (@tmpfiles) {
$filenames .= ' ' . join(', ', splice(@tmpfiles, 0, 6)) . "\n";
}
print STDERR "Found ", scalar @files, " GIF files:\n$filenames";
}
foreach my $f (@files) {
open(GIF, "$gifdir/$f") || die "$gifdir/$f: $!\n";
$gifs->{ $f } = <GIF>;
close(GIF);
}
return $gifs;
}
sub colour_gif {
my ($gif, $r, $g, $b) = @_;
unless (defined $g) {
($r, $g, $b) = make_rgb($r);
}
# the first and only RGB entry in the colour table runs from
# bytes 13 to 15
vec($gif, 13, 8) = $r;
vec($gif, 14, 8) = $g;
vec($gif, 15, 8) = $b;
return $gif;
}
sub make_rgb {
my $rgbhash = shift;
$rgbhash =~ /^\#?(..)(..)(..)$/;
return map { hex($_) } ($1, $2, $3);
}
sub usage {
print STDERR <<EOF;
$PROGRAM: colorise source GIFs to create Splash! colour sets
usage: $PROGRAM [options]
-s /src/dir source directory
-d /dest/dir destination directory
-i /tt2/dir TT2 installation directory
-v verbose mode
-h this help
EOF
exit();
}
#------------------------------------------------------------------------
__END__
[% "Bursting into colour...\n " | stderr IF verbose;
n = 0;
FOREACH col = rgb.keys;
"\n " | stderr IF verbose and ! loop.count % 8;
NEXT IF rgb.${col}.keys;
"$col, " | stderr IF verbose;
FOREACH gifname = gifs.keys;
colour(gifs.$gifname, rgb.$col) | redirect("$col/$gifname", 1);
END;
n = n + 1;
END;
"\nGenerated $n background colours\n\n" | stderr IF verbose;
%]