1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
#!/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;
%]
|
