| 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; |
| 88 | foreach $_ (@ARGV) { |
| 89 | if (/^-(24|8|4|1)$/) { |
| 90 | $depth = $1; |
| 91 | } elsif (defined $depth) { |
| 92 | &readicon($_, $depth); |
| 93 | } else { |
| 94 | $usage = 1; |
| 95 | } |
| 96 | } |
| 97 | if ($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. |
| 104 | print pack "vvv", 0, 1, scalar @hdr; # file-level header |
| 105 | $filepos = 6 + 16 * scalar @hdr; |
| 106 | for ($i = 0; $i < scalar @hdr; $i++) { |
| 107 | print $hdr[$i]; |
| 108 | print pack "V", $filepos; |
| 109 | $filepos += length($dat[$i]); |
| 110 | } |
| 111 | for ($i = 0; $i < scalar @hdr; $i++) { |
| 112 | print $dat[$i]; |
| 113 | } |
| 114 | |
| 115 | sub 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 | } |