icons/icon.pl

   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                         die "illegal colour value $pix at pixel $i in $filename\n";
 207                     }
 208                     $currbyte |= $pal{$pix};
 209                 }
 210                 if ($currbits >= 8) {
 211                     $raster .= pack "C", $currbyte;
 212                     $currbits -= 8;
 213                 }
 214             }
 215         }
 216     } else {
 217         # For a 24-bit image, reverse the order of the R,G,B values
 218         # and stick a padding zero on the end.
 219         #
 220         # (In this loop we don't need to bother padding the
 221         # scanline out to a multiple of four bytes, because every
 222         # pixel takes four whole bytes anyway.)
 223         for ($i = 0; $i < scalar @$data; $i++) {
 224             if (defined $data->[$i]) {
 225                 $raster .= $data->[$i];
 226             } else {
 227                 $raster .= "\x00\x00\x00\x00";
 228             }
 229         }
 230         $depth = 32; # and adjust this
 231     }
 232
 233     # Prepare the icon data. First the header...
 234     my $data = pack "VVVvvVVVVVV",
 235       40, # size of bitmap info header
 236       $w, # icon width
 237       $h*2, # icon height (x2 to indicate the subsequent alpha channel)
 238       1, # 1 plane (common to all MS image formats)
 239       $depth, # bits per pixel
 240       0, # no compression
 241       length $raster, # image size
 242       0, 0, 0, 0; # resolution, colours used, colours important (ignored)
 243     # ... then the palette ...
 244     if ($depth <= 8) {
 245         my $ncols = (1 << $depth);
 246         my $palette = "\x00\x00\x00\x00" x $ncols;
 247         foreach $i (keys %pal) {
 248             substr($palette, $pal{$i}*4, 4) = $i;
 249         }
 250         $data .= $palette;
 251     }
 252     # ... the raster data we already had ready ...
 253     $data .= $raster;
 254     # ... and the alpha channel we already had as well.
 255     $data .= $alpha;
 256
 257     # Prepare the header which will represent this image in the
 258     # icon file.
 259     my $header = pack "CCCCvvV",
 260       $w, $h, # width and height (this time the real height)
 261       1 << $depth, # number of colours, if less than 256
 262       0, # reserved
 263       1, # planes
 264       $depth, # bits per pixel
 265       length $data; # size of real icon data
 266
 267     push @hdr, $header;
 268     push @dat, $data;
 269 }