putty/ICONS/ICON.PL

   1 #!/usr/bin/perl \r
   2 \r
   3 # Take a collection of input image files and convert them into a\r
   4 # multi-resolution Windows .ICO icon file.\r
   5 #\r
   6 # The input images can be treated as having four different colour\r
   7 # depths:\r
   8 #\r
   9 #  - 24-bit true colour\r
  10 #  - 8-bit with custom palette\r
  11 #  - 4-bit using the Windows 16-colour palette (see comment below\r
  12 #    for details)\r
  13 #  - 1-bit using black and white only.\r
  14 #\r
  15 # The images can be supplied in any input format acceptable to\r
  16 # ImageMagick, but their actual colour usage must already be\r
  17 # appropriate for the specified mode; this script will not do any\r
  18 # substantive conversion. So if an image intended to be used in 4-\r
  19 # or 1-bit mode contains any colour not in the appropriate fixed\r
  20 # palette, that's a fatal error; if an image to be used in 8-bit\r
  21 # mode contains more than 256 distinct colours, that's also a fatal\r
  22 # error.\r
  23 #\r
  24 # Command-line syntax is:\r
  25 #\r
  26 #   icon.pl -depth imagefile [imagefile...] [-depth imagefile [imagefile...]]\r
  27 #\r
  28 # where `-depth' is one of `-24', `-8', `-4' or `-1', and tells the\r
  29 # script how to treat all the image files given after that option\r
  30 # until the next depth option. For example, you might execute\r
  31 #\r
  32 #   icon.pl -24 48x48x24.png 32x32x24.png -8 32x32x8.png -1 monochrome.png\r
  33 #\r
  34 # to build an icon file containing two differently sized 24-bit\r
  35 # images, one 8-bit image and one black and white image.\r
  36 #\r
  37 # Windows .ICO files support a 1-bit alpha channel on all these\r
  38 # image types. That is, any pixel can be either opaque or fully\r
  39 # transparent, but not partially transparent. The alpha channel is\r
  40 # separate from the main image data, meaning that `transparent' is\r
  41 # not required to take up a palette entry. (So an 8-bit image can\r
  42 # have 256 distinct _opaque_ colours, plus transparent pixels as\r
  43 # well.) If the input images have alpha channels, they will be used\r
  44 # to determine which pixels of the icon are transparent, by simple\r
  45 # quantisation half way up (e.g. in a PNG image with an 8-bit alpha\r
  46 # channel, alpha values of 00-7F will be mapped to transparent\r
  47 # pixels, and 80-FF will become opaque).\r
  48 \r
  49 # The Windows 16-colour palette consists of:\r
  50 #  - the eight corners of the colour cube (000000, 0000FF, 00FF00,\r
  51 #    00FFFF, FF0000, FF00FF, FFFF00, FFFFFF)\r
  52 #  - dim versions of the seven non-black corners, at 128/255 of the\r
  53 #    brightness (000080, 008000, 008080, 800000, 800080, 808000,\r
  54 #    808080)\r
  55 #  - light grey at 192/255 of full brightness (C0C0C0).\r
  56 %win16pal = (\r
  57     "\x00\x00\x00\x00" => 0,\r
  58     "\x00\x00\x80\x00" => 1,\r
  59     "\x00\x80\x00\x00" => 2,\r
  60     "\x00\x80\x80\x00" => 3,\r
  61     "\x80\x00\x00\x00" => 4,\r
  62     "\x80\x00\x80\x00" => 5,\r
  63     "\x80\x80\x00\x00" => 6,\r
  64     "\xC0\xC0\xC0\x00" => 7,\r
  65     "\x80\x80\x80\x00" => 8,\r
  66     "\x00\x00\xFF\x00" => 9,\r
  67     "\x00\xFF\x00\x00" => 10,\r
  68     "\x00\xFF\xFF\x00" => 11,\r
  69     "\xFF\x00\x00\x00" => 12,\r
  70     "\xFF\x00\xFF\x00" => 13,\r
  71     "\xFF\xFF\x00\x00" => 14,\r
  72     "\xFF\xFF\xFF\x00" => 15,\r
  73 );\r
  74 @win16pal = sort { $win16pal{$a} <=> $win16pal{$b} } keys %win16pal;\r
  75 \r
  76 # The black and white palette consists of black (000000) and white\r
  77 # (FFFFFF), obviously.\r
  78 %win2pal = (\r
  79     "\x00\x00\x00\x00" => 0,\r
  80     "\xFF\xFF\xFF\x00" => 1,\r
  81 );\r
  82 @win2pal = sort { $win16pal{$a} <=> $win2pal{$b} } keys %win2pal;\r
  83 \r
  84 @hdr = ();\r
  85 @dat = ();\r
  86 \r
  87 $depth = undef;\r
  88 foreach $_ (@ARGV) {\r
  89     if (/^-(24|8|4|1)$/) {\r
  90         $depth = $1;\r
  91     } elsif (defined $depth) {\r
  92         &readicon($_, $depth);\r
  93     } else {\r
  94         $usage = 1;\r
  95     }\r
  96 }\r
  97 if ($usage || length @hdr == 0) {\r
  98     print "usage: icon.pl ( -24 | -8 | -4 | -1 ) image [image...]\n";\r
  99     print "             [ ( -24 | -8 | -4 | -1 ) image [image...] ...]\n";\r
 100     exit 0;\r
 101 }\r
 102 \r
 103 # Now write out the output icon file.\r
 104 print pack "vvv", 0, 1, scalar @hdr; # file-level header\r
 105 $filepos = 6 + 16 * scalar @hdr;\r
 106 for ($i = 0; $i < scalar @hdr; $i++) {\r
 107     print $hdr[$i];\r
 108     print pack "V", $filepos;\r
 109     $filepos += length($dat[$i]);\r
 110 }\r
 111 for ($i = 0; $i < scalar @hdr; $i++) {\r
 112     print $dat[$i];\r
 113 }\r
 114 \r
 115 sub readicon {\r
 116     my $filename = shift @_;\r
 117     my $depth = shift @_;\r
 118     my $pix;\r
 119     my $i;\r
 120     my %pal;\r
 121 \r
 122     # Determine the icon's width and height.\r
 123     my $w = `identify -format %w $filename`;\r
 124     my $h = `identify -format %h $filename`;\r
 125 \r
 126     # Read the file in as RGBA data. We flip vertically at this\r
 127     # point, to avoid having to do it ourselves (.BMP and hence\r
 128     # .ICO are bottom-up).\r
 129     my $data = [];\r
 130     open IDATA, "convert -flip -depth 8 $filename rgba:- |";\r
 131     push @$data, $rgb while (read IDATA,$rgb,4,0) == 4;\r
 132     close IDATA;\r
 133     # Check we have the right amount of data.\r
 134     $xl = $w * $h;\r
 135     $al = scalar @$data;\r
 136     die "wrong amount of image data ($al, expected $xl) from $filename\n"\r
 137       unless $al == $xl;\r
 138 \r
 139     # Build the alpha channel now, so we can exclude transparent\r
 140     # pixels from the palette analysis. We replace transparent\r
 141     # pixels with undef in the data array.\r
 142     #\r
 143     # We quantise the alpha channel half way up, so that alpha of\r
 144     # 0x80 or more is taken to be fully opaque and 0x7F or less is\r
 145     # fully transparent. Nasty, but the best we can do without\r
 146     # dithering (and don't even suggest we do that!).\r
 147     my $x;\r
 148     my $y;\r
 149     my $alpha = "";\r
 150 \r
 151     for ($y = 0; $y < $h; $y++) {\r
 152         my $currbyte = 0, $currbits = 0;\r
 153         for ($x = 0; $x < (($w+31)|31)-31; $x++) {\r
 154             $pix = ($x < $w ? $data->[$y*$w+$x] : "\x00\x00\x00\xFF");\r
 155             my @rgba = unpack "CCCC", $pix;\r
 156             $currbyte <<= 1;\r
 157             $currbits++;\r
 158             if ($rgba[3] < 0x80) {\r
 159                 if ($x < $w) {\r
 160                     $data->[$y*$w+$x] = undef;\r
 161                 }\r
 162                 $currbyte |= 1; # MS has the alpha channel inverted :-)\r
 163             } else {\r
 164                 # Might as well flip RGBA into BGR0 while we're here.\r
 165                 if ($x < $w) {\r
 166                     $data->[$y*$w+$x] = pack "CCCC",\r
 167                       $rgba[2], $rgba[1], $rgba[0], 0;\r
 168                 }\r
 169             }\r
 170             if ($currbits >= 8) {\r
 171                 $alpha .= pack "C", $currbyte;\r
 172                 $currbits -= 8;\r
 173             }\r
 174         }\r
 175     }\r
 176 \r
 177     # For an 8-bit image, check we have at most 256 distinct\r
 178     # colours, and build the palette.\r
 179     %pal = ();\r
 180     if ($depth == 8) {\r
 181         my $palindex = 0;\r
 182         foreach $pix (@$data) {\r
 183             next unless defined $pix;\r
 184             $pal{$pix} = $palindex++ unless defined $pal{$pix};\r
 185         }\r
 186         die "too many colours in 8-bit image $filename\n" unless $palindex <= 256;\r
 187     } elsif ($depth == 4) {\r
 188         %pal = %win16pal;\r
 189     } elsif ($depth == 1) {\r
 190         %pal = %win2pal;\r
 191     }\r
 192 \r
 193     my $raster = "";\r
 194     if ($depth < 24) {\r
 195         # For a non-24-bit image, flatten the image into one palette\r
 196         # index per pixel.\r
 197         $pad = 32 / $depth; # number of pixels to pad scanline to 4-byte align\r
 198         $pmask = $pad-1;\r
 199         for ($y = 0; $y < $h; $y++) {\r
 200             my $currbyte = 0, $currbits = 0;\r
 201             for ($x = 0; $x < (($w+$pmask)|$pmask)-$pmask; $x++) {\r
 202                 $currbyte <<= $depth;\r
 203                 $currbits += $depth;\r
 204                 if ($x < $w && defined ($pix = $data->[$y*$w+$x])) {\r
 205                     if (!defined $pal{$pix}) {\r
 206                         $pixhex = sprintf "%02x%02x%02x", unpack "CCC", $pix;\r
 207                         die "illegal colour value $pixhex at pixel ($x,$y) in $filename\n";\r
 208                     }\r
 209                     $currbyte |= $pal{$pix};\r
 210                 }\r
 211                 if ($currbits >= 8) {\r
 212                     $raster .= pack "C", $currbyte;\r
 213                     $currbits -= 8;\r
 214                 }\r
 215             }\r
 216         }\r
 217     } else {\r
 218         # For a 24-bit image, reverse the order of the R,G,B values\r
 219         # and stick a padding zero on the end.\r
 220         #\r
 221         # (In this loop we don't need to bother padding the\r
 222         # scanline out to a multiple of four bytes, because every\r
 223         # pixel takes four whole bytes anyway.)\r
 224         for ($i = 0; $i < scalar @$data; $i++) {\r
 225             if (defined $data->[$i]) {\r
 226                 $raster .= $data->[$i];\r
 227             } else {\r
 228                 $raster .= "\x00\x00\x00\x00";\r
 229             }\r
 230         }\r
 231         $depth = 32; # and adjust this\r
 232     }\r
 233 \r
 234     # Prepare the icon data. First the header...\r
 235     my $data = pack "VVVvvVVVVVV",\r
 236       40, # size of bitmap info header\r
 237       $w, # icon width\r
 238       $h*2, # icon height (x2 to indicate the subsequent alpha channel)\r
 239       1, # 1 plane (common to all MS image formats)\r
 240       $depth, # bits per pixel\r
 241       0, # no compression\r
 242       length $raster, # image size\r
 243       0, 0, 0, 0; # resolution, colours used, colours important (ignored)\r
 244     # ... then the palette ...\r
 245     if ($depth <= 8) {\r
 246         my $ncols = (1 << $depth);\r
 247         my $palette = "\x00\x00\x00\x00" x $ncols;\r
 248         foreach $i (keys %pal) {\r
 249             substr($palette, $pal{$i}*4, 4) = $i;\r
 250         }\r
 251         $data .= $palette;\r
 252     }\r
 253     # ... the raster data we already had ready ...\r
 254     $data .= $raster;\r
 255     # ... and the alpha channel we already had as well.\r
 256     $data .= $alpha;\r
 257 \r
 258     # Prepare the header which will represent this image in the\r
 259     # icon file.\r
 260     my $header = pack "CCCCvvV",\r
 261       $w, $h, # width and height (this time the real height)\r
 262       1 << $depth, # number of colours, if less than 256\r
 263       0, # reserved\r
 264       1, # planes\r
 265       $depth, # bits per pixel\r
 266       length $data; # size of real icon data\r
 267 \r
 268     push @hdr, $header;\r
 269     push @dat, $data;\r
 270 }\r