| 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 | } |