icons/icon.pl

   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 }