Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 144 lines (115 sloc) 3.334 kb
911a5e37 »
2001-04-04 *** empty log message ***
1 #!/usr/bin/perl -w # -*- perl -*-
2 #
3 # gifsplash (bin/gifsplash)
4 #
5 # This script explodes the set of black images distributed with the
6 # Template Toolkit (images/splash/black/*) into the colours specified
7 # in the html/rgb template (templates/html/rgb). It is run at "make
8 # install" time and operates on the TT2 installation directory. Note
2de5c389 »
2001-08-21 misc doc updates for 2.05
9 # that the main loop runs in template space where there is convenient
911a5e37 »
2001-04-04 *** empty log message ***
10 # access to the RGB definitions.
11 #
12 #
13
14 use strict;
15 use Template;
16 use Getopt::Std;
17
18 my $PROGRAM = 'gifsplash';
2de5c389 »
2001-08-21 misc doc updates for 2.05
19 my $VERSION = 0.03;
911a5e37 »
2001-04-04 *** empty log message ***
20 my $MASKDIR = 'black';
21
22
23 my $args = { };
24 getopts('vs:d:i:h', $args);
25 usage() if $args->{ h };
26 my ($verbose, $src, $dest, $inst) = @$args{ qw( v s d i ) };
27
28 $inst ||= Template::Config->instdir()
29 || die "Cannot determine Template Toolkit installation directory\n";
30
31 $src ||= "$inst/images/splash/$MASKDIR";
32 $dest ||= "$inst/images/splash";
33
34 if ($verbose) {
35 print STDERR <<EOF;
ca4050f2 »
2001-04-06 prep for 2.02
36 Weaving the rainbow: blowing colour into Splash! GIFs
911a5e37 »
2001-04-04 *** empty log message ***
37 src: $src
38 dest: $dest/*
39 EOF
40 }
41
42 my $tt = Template->new(
43 INCLUDE_PATH => "$inst/templates",
44 PRE_PROCESS => 'html/rgb',
45 OUTPUT_PATH => $dest,
7524ab55 »
2001-11-09 2.06 release
46 ) || die Template->error(), "\n";
911a5e37 »
2001-04-04 *** empty log message ***
47
48 my $vars = {
49 gifs => load_gifs($src),
50 colour => \&colour_gif,
51 verbose => $verbose,
52 };
53 my $out;
54
55 $tt->process(\*DATA, $vars, \$out)
56 || die $tt->error(), "\n";
57
58
59 #------------------------------------------------------------------------
60
61 sub load_gifs {
62 my $gifdir = shift;
63 my (@files, $gifs);
64 local (*DIR, *GIF);
65 local $" = ', ';
66 local $/ = undef;
67
68 opendir(DIR, $gifdir) || die "$gifdir: $!";
69 @files = grep { /\.gif$/ } readdir(DIR);
70 closedir DIR;
71
f4df3b6f »
2001-06-14 approach v2.03
72 if ($verbose) {
73 my $filenames = '';
74 my @tmpfiles = @files;
75 while (@tmpfiles) {
76 $filenames .= ' ' . join(', ', splice(@tmpfiles, 0, 6)) . "\n";
77 }
78 print STDERR "Found ", scalar @files, " GIF files:\n$filenames";
79 }
911a5e37 »
2001-04-04 *** empty log message ***
80
81 foreach my $f (@files) {
82 open(GIF, "$gifdir/$f") || die "$gifdir/$f: $!\n";
83 $gifs->{ $f } = <GIF>;
84 close(GIF);
85 }
86
87 return $gifs;
88 }
89
90 sub colour_gif {
91 my ($gif, $r, $g, $b) = @_;
92
93 unless (defined $g) {
94 ($r, $g, $b) = make_rgb($r);
95 }
96
97 # the first and only RGB entry in the colour table runs from
98 # bytes 13 to 15
99 vec($gif, 13, 8) = $r;
100 vec($gif, 14, 8) = $g;
101 vec($gif, 15, 8) = $b;
102
103 return $gif;
104 }
105
106 sub make_rgb {
107 my $rgbhash = shift;
108 $rgbhash =~ /^\#?(..)(..)(..)$/;
109 return map { hex($_) } ($1, $2, $3);
110 }
111
112 sub usage {
113 print STDERR <<EOF;
114 $PROGRAM: colorise source GIFs to create Splash! colour sets
115
116 usage: $PROGRAM [options]
117 -s /src/dir source directory
118 -d /dest/dir destination directory
119 -i /tt2/dir TT2 installation directory
120 -v verbose mode
121 -h this help
122 EOF
123 exit();
124 }
125
126
127 #------------------------------------------------------------------------
128 __END__
ca4050f2 »
2001-04-06 prep for 2.02
129 [% "Bursting into colour...\n " | stderr IF verbose;
130 n = 0;
911a5e37 »
2001-04-04 *** empty log message ***
131 FOREACH col = rgb.keys;
132 "\n " | stderr IF verbose and ! loop.count % 8;
133 NEXT IF rgb.${col}.keys;
134 "$col, " | stderr IF verbose;
135 FOREACH gifname = gifs.keys;
ca4050f2 »
2001-04-06 prep for 2.02
136 colour(gifs.$gifname, rgb.$col) | redirect("$col/$gifname", 1);
911a5e37 »
2001-04-04 *** empty log message ***
137 END;
ca4050f2 »
2001-04-06 prep for 2.02
138 n = n + 1;
911a5e37 »
2001-04-04 *** empty log message ***
139 END;
ca4050f2 »
2001-04-06 prep for 2.02
140 "\nGenerated $n background colours\n\n" | stderr IF verbose;
911a5e37 »
2001-04-04 *** empty log message ***
141 %]
ca4050f2 »
2001-04-06 prep for 2.02
142
143
Something went wrong with that request. Please try again.