]> git.ipfire.org Git - people/ms/putty.git/blame - icons/icon.pl
Add search to connection list box.
[people/ms/putty.git] / icons / icon.pl
CommitLineData
1c1af145 1#!/usr/bin/perl
2
3# Take a collection of input image files and convert them into a
4# multi-resolution Windows .ICO icon file.
5#
6# The input images can be treated as having four different colour
7# depths:
8#
9# - 24-bit true colour
10# - 8-bit with custom palette
11# - 4-bit using the Windows 16-colour palette (see comment below
12# for details)
13# - 1-bit using black and white only.
14#
15# The images can be supplied in any input format acceptable to
16# ImageMagick, but their actual colour usage must already be
17# appropriate for the specified mode; this script will not do any
18# substantive conversion. So if an image intended to be used in 4-
19# or 1-bit mode contains any colour not in the appropriate fixed
20# palette, that's a fatal error; if an image to be used in 8-bit
21# mode contains more than 256 distinct colours, that's also a fatal
22# error.
23#
24# Command-line syntax is:
25#
26# icon.pl -depth imagefile [imagefile...] [-depth imagefile [imagefile...]]
27#
28# where `-depth' is one of `-24', `-8', `-4' or `-1', and tells the
29# script how to treat all the image files given after that option
30# until the next depth option. For example, you might execute
31#
32# icon.pl -24 48x48x24.png 32x32x24.png -8 32x32x8.png -1 monochrome.png
33#
34# to build an icon file containing two differently sized 24-bit
35# images, one 8-bit image and one black and white image.
36#
37# Windows .ICO files support a 1-bit alpha channel on all these
38# image types. That is, any pixel can be either opaque or fully
39# transparent, but not partially transparent. The alpha channel is
40# separate from the main image data, meaning that `transparent' is
41# not required to take up a palette entry. (So an 8-bit image can
42# have 256 distinct _opaque_ colours, plus transparent pixels as
43# well.) If the input images have alpha channels, they will be used
44# to determine which pixels of the icon are transparent, by simple
45# quantisation half way up (e.g. in a PNG image with an 8-bit alpha
46# channel, alpha values of 00-7F will be mapped to transparent
47# pixels, and 80-FF will become opaque).
48
49# The Windows 16-colour palette consists of:
50# - the eight corners of the colour cube (000000, 0000FF, 00FF00,
51# 00FFFF, FF0000, FF00FF, FFFF00, FFFFFF)
52# - dim versions of the seven non-black corners, at 128/255 of the
53# brightness (000080, 008000, 008080, 800000, 800080, 808000,
54# 808080)
55# - light grey at 192/255 of full brightness (C0C0C0).
56%win16pal = (
57 "\x00\x00\x00\x00" => 0,
58 "\x00\x00\x80\x00" => 1,
59 "\x00\x80\x00\x00" => 2,
60 "\x00\x80\x80\x00" => 3,
61 "\x80\x00\x00\x00" => 4,
62 "\x80\x00\x80\x00" => 5,
63 "\x80\x80\x00\x00" => 6,
64 "\xC0\xC0\xC0\x00" => 7,
65 "\x80\x80\x80\x00" => 8,
66 "\x00\x00\xFF\x00" => 9,
67 "\x00\xFF\x00\x00" => 10,
68 "\x00\xFF\xFF\x00" => 11,
69 "\xFF\x00\x00\x00" => 12,
70 "\xFF\x00\xFF\x00" => 13,
71 "\xFF\xFF\x00\x00" => 14,
72 "\xFF\xFF\xFF\x00" => 15,
73);
74@win16pal = sort { $win16pal{$a} <=> $win16pal{$b} } keys %win16pal;
75
76# The black and white palette consists of black (000000) and white
77# (FFFFFF), obviously.
78%win2pal = (
79 "\x00\x00\x00\x00" => 0,
80 "\xFF\xFF\xFF\x00" => 1,
81);
82@win2pal = sort { $win16pal{$a} <=> $win2pal{$b} } keys %win2pal;
83
84@hdr = ();
85@dat = ();
86
87$depth = undef;
88foreach $_ (@ARGV) {
89 if (/^-(24|8|4|1)$/) {
90 $depth = $1;
91 } elsif (defined $depth) {
92 &readicon($_, $depth);
93 } else {
94 $usage = 1;
95 }
96}
97if ($usage || length @hdr == 0) {
98 print "usage: icon.pl ( -24 | -8 | -4 | -1 ) image [image...]\n";
99 print " [ ( -24 | -8 | -4 | -1 ) image [image...] ...]\n";
100 exit 0;
101}
102
103# Now write out the output icon file.
104print pack "vvv", 0, 1, scalar @hdr; # file-level header
105$filepos = 6 + 16 * scalar @hdr;
106for ($i = 0; $i < scalar @hdr; $i++) {
107 print $hdr[$i];
108 print pack "V", $filepos;
109 $filepos += length($dat[$i]);
110}
111for ($i = 0; $i < scalar @hdr; $i++) {
112 print $dat[$i];
113}
114
115sub readicon {
116 my $filename = shift @_;
117 my $depth = shift @_;
118 my $pix;
119 my $i;
120 my %pal;
121
122 # Determine the icon's width and height.
123 my $w = `identify -format %w $filename`;
124 my $h = `identify -format %h $filename`;
125
126 # Read the file in as RGBA data. We flip vertically at this
127 # point, to avoid having to do it ourselves (.BMP and hence
128 # .ICO are bottom-up).
129 my $data = [];
130 open IDATA, "convert -flip -depth 8 $filename rgba:- |";
131 push @$data, $rgb while (read IDATA,$rgb,4,0) == 4;
132 close IDATA;
133 # Check we have the right amount of data.
134 $xl = $w * $h;
135 $al = scalar @$data;
136 die "wrong amount of image data ($al, expected $xl) from $filename\n"
137 unless $al == $xl;
138
139 # Build the alpha channel now, so we can exclude transparent
140 # pixels from the palette analysis. We replace transparent
141 # pixels with undef in the data array.
142 #
143 # We quantise the alpha channel half way up, so that alpha of
144 # 0x80 or more is taken to be fully opaque and 0x7F or less is
145 # fully transparent. Nasty, but the best we can do without
146 # dithering (and don't even suggest we do that!).
147 my $x;
148 my $y;
149 my $alpha = "";
150
151 for ($y = 0; $y < $h; $y++) {
152 my $currbyte = 0, $currbits = 0;
153 for ($x = 0; $x < (($w+31)|31)-31; $x++) {
154 $pix = ($x < $w ? $data->[$y*$w+$x] : "\x00\x00\x00\xFF");
155 my @rgba = unpack "CCCC", $pix;
156 $currbyte <<= 1;
157 $currbits++;
158 if ($rgba[3] < 0x80) {
159 if ($x < $w) {
160 $data->[$y*$w+$x] = undef;
161 }
162 $currbyte |= 1; # MS has the alpha channel inverted :-)
163 } else {
164 # Might as well flip RGBA into BGR0 while we're here.
165 if ($x < $w) {
166 $data->[$y*$w+$x] = pack "CCCC",
167 $rgba[2], $rgba[1], $rgba[0], 0;
168 }
169 }
170 if ($currbits >= 8) {
171 $alpha .= pack "C", $currbyte;
172 $currbits -= 8;
173 }
174 }
175 }
176
177 # For an 8-bit image, check we have at most 256 distinct
178 # colours, and build the palette.
179 %pal = ();
180 if ($depth == 8) {
181 my $palindex = 0;
182 foreach $pix (@$data) {
183 next unless defined $pix;
184 $pal{$pix} = $palindex++ unless defined $pal{$pix};
185 }
186 die "too many colours in 8-bit image $filename\n" unless $palindex <= 256;
187 } elsif ($depth == 4) {
188 %pal = %win16pal;
189 } elsif ($depth == 1) {
190 %pal = %win2pal;
191 }
192
193 my $raster = "";
194 if ($depth < 24) {
195 # For a non-24-bit image, flatten the image into one palette
196 # index per pixel.
197 $pad = 32 / $depth; # number of pixels to pad scanline to 4-byte align
198 $pmask = $pad-1;
199 for ($y = 0; $y < $h; $y++) {
200 my $currbyte = 0, $currbits = 0;
201 for ($x = 0; $x < (($w+$pmask)|$pmask)-$pmask; $x++) {
202 $currbyte <<= $depth;
203 $currbits += $depth;
204 if ($x < $w && defined ($pix = $data->[$y*$w+$x])) {
205 if (!defined $pal{$pix}) {
206 $pixhex = sprintf "%02x%02x%02x", unpack "CCC", $pix;
207 die "illegal colour value $pixhex at pixel ($x,$y) in $filename\n";
208 }
209 $currbyte |= $pal{$pix};
210 }
211 if ($currbits >= 8) {
212 $raster .= pack "C", $currbyte;
213 $currbits -= 8;
214 }
215 }
216 }
217 } else {
218 # For a 24-bit image, reverse the order of the R,G,B values
219 # and stick a padding zero on the end.
220 #
221 # (In this loop we don't need to bother padding the
222 # scanline out to a multiple of four bytes, because every
223 # pixel takes four whole bytes anyway.)
224 for ($i = 0; $i < scalar @$data; $i++) {
225 if (defined $data->[$i]) {
226 $raster .= $data->[$i];
227 } else {
228 $raster .= "\x00\x00\x00\x00";
229 }
230 }
231 $depth = 32; # and adjust this
232 }
233
234 # Prepare the icon data. First the header...
235 my $data = pack "VVVvvVVVVVV",
236 40, # size of bitmap info header
237 $w, # icon width
238 $h*2, # icon height (x2 to indicate the subsequent alpha channel)
239 1, # 1 plane (common to all MS image formats)
240 $depth, # bits per pixel
241 0, # no compression
242 length $raster, # image size
243 0, 0, 0, 0; # resolution, colours used, colours important (ignored)
244 # ... then the palette ...
245 if ($depth <= 8) {
246 my $ncols = (1 << $depth);
247 my $palette = "\x00\x00\x00\x00" x $ncols;
248 foreach $i (keys %pal) {
249 substr($palette, $pal{$i}*4, 4) = $i;
250 }
251 $data .= $palette;
252 }
253 # ... the raster data we already had ready ...
254 $data .= $raster;
255 # ... and the alpha channel we already had as well.
256 $data .= $alpha;
257
258 # Prepare the header which will represent this image in the
259 # icon file.
260 my $header = pack "CCCCvvV",
261 $w, $h, # width and height (this time the real height)
262 1 << $depth, # number of colours, if less than 256
263 0, # reserved
264 1, # planes
265 $depth, # bits per pixel
266 length $data; # size of real icon data
267
268 push @hdr, $header;
269 push @dat, $data;
270}