fbd2dc51 |
1 | #!/usr/bin/perl |
2 | |
3 | # Take nine input image files and convert them into a |
4 | # multi-resolution Windows .ICO icon file. The nine files should |
5 | # be, in order: |
6 | # |
7 | # - 48x48 icons at 24-bit, 8-bit and 4-bit colour depth respectively |
8 | # - 32x32 icons at 24-bit, 8-bit and 4-bit colour depth respectively |
9 | # - 16x16 icons at 24-bit, 8-bit and 4-bit colour depth respectively |
10 | # |
11 | # ICO files support a 1-bit alpha channel on all these image types. |
12 | # |
13 | # TODO: it would be nice if we could extend this icon builder to |
14 | # support monochrome icons and a user-specified subset of the |
15 | # available formats. None of that should be too hard: the |
16 | # monochrome raster data has the same format as the alpha channel, |
17 | # monochrome images have a 2-colour palette containing 000000 and |
18 | # FFFFFF respectively, and really the biggest problem is designing |
19 | # a sensible command-line syntax! |
20 | |
21 | %win16pal = ( |
22 | "\x00\x00\x00\x00" => 0, |
23 | "\x00\x00\x80\x00" => 1, |
24 | "\x00\x80\x00\x00" => 2, |
25 | "\x00\x80\x80\x00" => 3, |
26 | "\x80\x00\x00\x00" => 4, |
27 | "\x80\x00\x80\x00" => 5, |
28 | "\x80\x80\x00\x00" => 6, |
29 | "\xC0\xC0\xC0\x00" => 7, |
30 | "\x80\x80\x80\x00" => 8, |
31 | "\x00\x00\xFF\x00" => 9, |
32 | "\x00\xFF\x00\x00" => 10, |
33 | "\x00\xFF\xFF\x00" => 11, |
34 | "\xFF\x00\x00\x00" => 12, |
35 | "\xFF\x00\xFF\x00" => 13, |
36 | "\xFF\xFF\x00\x00" => 14, |
37 | "\xFF\xFF\xFF\x00" => 15, |
38 | ); |
39 | @win16pal = sort { $win16pal{$a} <=> $win16pal{$b} } keys %win16pal; |
40 | |
41 | @hdr = (); |
42 | @dat = (); |
43 | |
44 | &readicon($ARGV[0], 48, 48, 24); |
45 | &readicon($ARGV[1], 48, 48, 8); |
46 | &readicon($ARGV[2], 48, 48, 4); |
47 | &readicon($ARGV[3], 32, 32, 24); |
48 | &readicon($ARGV[4], 32, 32, 8); |
49 | &readicon($ARGV[5], 32, 32, 4); |
50 | &readicon($ARGV[6], 16, 16, 24); |
51 | &readicon($ARGV[7], 16, 16, 8); |
52 | &readicon($ARGV[8], 16, 16, 4); |
53 | |
54 | # Now write out the output icon file. |
55 | print pack "vvv", 0, 1, scalar @hdr; # file-level header |
56 | $filepos = 6 + 16 * scalar @hdr; |
57 | for ($i = 0; $i < scalar @hdr; $i++) { |
58 | print $hdr[$i]; |
59 | print pack "V", $filepos; |
60 | $filepos += length($dat[$i]); |
61 | } |
62 | for ($i = 0; $i < scalar @hdr; $i++) { |
63 | print $dat[$i]; |
64 | } |
65 | |
66 | sub readicon { |
67 | my $filename = shift @_; |
68 | my $w = shift @_; |
69 | my $h = shift @_; |
70 | my $depth = shift @_; |
71 | my $pix; |
72 | my $i; |
73 | my %pal; |
74 | |
75 | # Read the file in as RGBA data. We flip vertically at this |
76 | # point, to avoid having to do it ourselves (.BMP and hence |
77 | # .ICO are bottom-up). |
78 | my $data = []; |
79 | open IDATA, "convert -flip -depth 8 $filename rgba:- |"; |
80 | push @$data, $rgb while (read IDATA,$rgb,4,0) == 4; |
81 | close IDATA; |
82 | # Check we have the right amount of data. |
83 | $xl = $w * $h; |
84 | $al = scalar @$data; |
85 | die "wrong amount of image data ($al, expected $xl) from $filename\n" |
86 | unless $al == $xl; |
87 | |
88 | # Build the alpha channel now, so we can exclude transparent |
89 | # pixels from the palette analysis. We replace transparent |
90 | # pixels with undef in the data array. |
91 | # |
92 | # We quantise the alpha channel half way up, so that alpha of |
93 | # 0x80 or more is taken to be fully opaque and 0x7F or less is |
94 | # fully transparent. Nasty, but the best we can do without |
95 | # dithering (and don't even suggest we do that!). |
96 | my $x; |
97 | my $y; |
98 | my $alpha = ""; |
99 | |
100 | for ($y = 0; $y < $h; $y++) { |
101 | my $currbyte = 0, $currbits = 0; |
102 | for ($x = 0; $x < (($w+31)|31)-31; $x++) { |
103 | $pix = ($x < $w ? $data->[$y*$w+$x] : "\x00\x00\x00\xFF"); |
104 | my @rgba = unpack "CCCC", $pix; |
105 | $currbyte <<= 1; |
106 | $currbits++; |
107 | if ($rgba[3] < 0x80) { |
108 | if ($x < $w) { |
109 | $data->[$y*$w+$x] = undef; |
110 | } |
111 | $currbyte |= 1; # MS has the alpha channel inverted :-) |
112 | } else { |
113 | # Might as well flip RGBA into BGR0 while we're here. |
114 | if ($x < $w) { |
115 | $data->[$y*$w+$x] = pack "CCCC", |
116 | $rgba[2], $rgba[1], $rgba[0], 0; |
117 | } |
118 | } |
119 | if ($currbits >= 8) { |
120 | $alpha .= pack "C", $currbyte; |
121 | $currbits -= 8; |
122 | } |
123 | } |
124 | } |
125 | |
126 | # For an 8-bit image, check we have at most 256 distinct |
127 | # colours, and build the palette. |
128 | %pal = (); |
129 | if ($depth == 8) { |
130 | my $palindex = 0; |
131 | foreach $pix (@$data) { |
132 | next unless defined $pix; |
133 | $pal{$pix} = $palindex++ unless defined $pal{$pix}; |
134 | } |
135 | die "too many colours in 8-bit image $filename\n" unless $palindex <= 256; |
136 | } elsif ($depth == 4) { |
137 | %pal = %win16pal; |
138 | } |
139 | |
140 | my $raster = ""; |
141 | if ($depth < 24) { |
142 | # For a non-24-bit image, flatten the image into one palette |
143 | # index per pixel. |
144 | my $currbyte = 0, $currbits = 0; |
145 | for ($i = 0; $i < scalar @$data; $i++) { |
146 | $pix = $data->[$i]; |
147 | $currbyte <<= $depth; |
148 | $currbits += $depth; |
149 | if (defined $pix) { |
150 | if (!defined $pal{$pix}) { |
151 | die "illegal colour value $pix at pixel $i in $filename\n"; |
152 | } |
153 | $currbyte |= $pal{$pix}; |
154 | } else { |
155 | $currbyte |= 0; |
156 | } |
157 | if ($currbits >= 8) { |
158 | $raster .= pack "C", $currbyte; |
159 | $currbits -= 8; |
160 | } |
161 | } |
162 | } else { |
163 | # For a 24-bit image, reverse the order of the R,G,B values |
164 | # and stick a padding zero on the end. |
165 | for ($i = 0; $i < scalar @$data; $i++) { |
166 | if (defined $data->[$i]) { |
167 | $raster .= $data->[$i]; |
168 | } else { |
169 | $raster .= "\x00\x00\x00\x00"; |
170 | } |
171 | } |
172 | $depth = 32; # and adjust this |
173 | } |
174 | |
175 | # Prepare the icon data. First the header... |
176 | my $data = pack "VVVvvVVVVVV", |
177 | 40, # size of bitmap info header |
178 | $w, # icon width |
179 | $h*2, # icon height (x2 to indicate the subsequent alpha channel) |
180 | 1, # 1 plane (common to all MS image formats) |
181 | $depth, # bits per pixel |
182 | 0, # no compression |
183 | length $raster, # image size |
184 | 0, 0, 0, 0; # resolution, colours used, colours important (ignored) |
185 | # ... then the palette ... |
186 | if ($depth <= 8) { |
187 | my $ncols = (1 << $depth); |
188 | my $palette = "\x00\x00\x00\x00" x $ncols; |
189 | foreach $i (keys %pal) { |
190 | substr($palette, $pal{$i}*4, 4) = $i; |
191 | } |
192 | $data .= $palette; |
193 | } |
194 | # ... the raster data we already had ready ... |
195 | $data .= $raster; |
196 | # ... and the alpha channel we already had as well. |
197 | $data .= $alpha; |
198 | |
199 | # Prepare the header which will represent this image in the |
200 | # icon file. |
201 | my $header = pack "CCCCvvV", |
202 | $w, $h, # width and height (this time the real height) |
203 | 1 << $depth, # number of colours, if less than 256 |
204 | 0, # reserved |
205 | 1, # planes |
206 | $depth, # bits per pixel |
207 | length $data; # size of real icon data |
208 | |
209 | push @hdr, $header; |
210 | push @dat, $data; |
211 | } |