[sgt/puzzles] / icons / icon.pl

#!/usr/bin/perl 

# Take a collection of input image files and convert them into a
# multi-resolution Windows .ICO icon file.
#
# The input images can be treated as having four different colour
# depths:
#
#  - 24-bit true colour
#  - 8-bit with custom palette
#  - 4-bit using the Windows 16-colour palette (see comment below
#    for details)
#  - 1-bit using black and white only.
#
# The images can be supplied in any input format acceptable to
# ImageMagick, but their actual colour usage must already be
# appropriate for the specified mode; this script will not do any
# substantive conversion. So if an image intended to be used in 4-
# or 1-bit mode contains any colour not in the appropriate fixed
# palette, that's a fatal error; if an image to be used in 8-bit
# mode contains more than 256 distinct colours, that's also a fatal
# error.
#
# Command-line syntax is:
#
#   icon.pl -depth imagefile [imagefile...] [-depth imagefile [imagefile...]]
#
# where `-depth' is one of `-24', `-8', `-4' or `-1', and tells the
# script how to treat all the image files given after that option
# until the next depth option. For example, you might execute
#
#   icon.pl -24 48x48x24.png 32x32x24.png -8 32x32x8.png -1 monochrome.png
#
# to build an icon file containing two differently sized 24-bit
# images, one 8-bit image and one black and white image.
#
# Windows .ICO files support a 1-bit alpha channel on all these
# image types. That is, any pixel can be either opaque or fully
# transparent, but not partially transparent. The alpha channel is
# separate from the main image data, meaning that `transparent' is
# not required to take up a palette entry. (So an 8-bit image can
# have 256 distinct _opaque_ colours, plus transparent pixels as
# well.) If the input images have alpha channels, they will be used
# to determine which pixels of the icon are transparent, by simple
# quantisation half way up (e.g. in a PNG image with an 8-bit alpha
# channel, alpha values of 00-7F will be mapped to transparent
# pixels, and 80-FF will become opaque).

# The Windows 16-colour palette consists of:
#  - the eight corners of the colour cube (000000, 0000FF, 00FF00,
#    00FFFF, FF0000, FF00FF, FFFF00, FFFFFF)
#  - dim versions of the seven non-black corners, at 128/255 of the
#    brightness (000080, 008000, 008080, 800000, 800080, 808000,
#    808080)
#  - light grey at 192/255 of full brightness (C0C0C0).
%win16pal = (
    "\x00\x00\x00\x00" => 0,
    "\x00\x00\x80\x00" => 1,
    "\x00\x80\x00\x00" => 2,
    "\x00\x80\x80\x00" => 3,
    "\x80\x00\x00\x00" => 4,
    "\x80\x00\x80\x00" => 5,
    "\x80\x80\x00\x00" => 6,
    "\xC0\xC0\xC0\x00" => 7,
    "\x80\x80\x80\x00" => 8,
    "\x00\x00\xFF\x00" => 9,
    "\x00\xFF\x00\x00" => 10,
    "\x00\xFF\xFF\x00" => 11,
    "\xFF\x00\x00\x00" => 12,
    "\xFF\x00\xFF\x00" => 13,
    "\xFF\xFF\x00\x00" => 14,
    "\xFF\xFF\xFF\x00" => 15,
);
@win16pal = sort { $win16pal{$a} <=> $win16pal{$b} } keys %win16pal;

# The black and white palette consists of black (000000) and white
# (FFFFFF), obviously.
%win2pal = (
    "\x00\x00\x00\x00" => 0,
    "\xFF\xFF\xFF\x00" => 1,
);
@win2pal = sort { $win16pal{$a} <=> $win2pal{$b} } keys %win2pal;

@hdr = ();
@dat = ();

$depth = undef;
foreach $_ (@ARGV) {
    if (/^-(24|8|4|1)$/) {
	$depth = $1;
    } elsif (defined $depth) {
	&readicon($_, $depth);
    } else {
	$usage = 1;
    }
}
if ($usage || length @hdr == 0) {
    print "usage: icon.pl ( -24 | -8 | -4 | -1 ) image [image...]\n";
    print "             [ ( -24 | -8 | -4 | -1 ) image [image...] ...]\n";
    exit 0;
}

# Now write out the output icon file.
print pack "vvv", 0, 1, scalar @hdr; # file-level header
$filepos = 6 + 16 * scalar @hdr;
for ($i = 0; $i < scalar @hdr; $i++) {
    print $hdr[$i];
    print pack "V", $filepos;
    $filepos += length($dat[$i]);
}
for ($i = 0; $i < scalar @hdr; $i++) {
    print $dat[$i];
}

sub readicon {
    my $filename = shift @_;
    my $depth = shift @_;
    my $pix;
    my $i;
    my %pal;

    # Determine the icon's width and height.
    my $w = `identify -format %w $filename`;
    my $h = `identify -format %h $filename`;

    # Read the file in as RGBA data. We flip vertically at this
    # point, to avoid having to do it ourselves (.BMP and hence
    # .ICO are bottom-up).
    my $data = [];
    open IDATA, "convert -flip -depth 8 $filename rgba:- |";
    push @$data, $rgb while (read IDATA,$rgb,4,0) == 4;
    close IDATA;
    # Check we have the right amount of data.
    $xl = $w * $h;
    $al = scalar @$data;
    die "wrong amount of image data ($al, expected $xl) from $filename\n"
      unless $al == $xl;

    # Build the alpha channel now, so we can exclude transparent
    # pixels from the palette analysis. We replace transparent
    # pixels with undef in the data array.
    #
    # We quantise the alpha channel half way up, so that alpha of
    # 0x80 or more is taken to be fully opaque and 0x7F or less is
    # fully transparent. Nasty, but the best we can do without
    # dithering (and don't even suggest we do that!).
    my $x;
    my $y;
    my $alpha = "";

    for ($y = 0; $y < $h; $y++) {
	my $currbyte = 0, $currbits = 0;
	for ($x = 0; $x < (($w+31)|31)-31; $x++) {
	    $pix = ($x < $w ? $data->[$y*$w+$x] : "\x00\x00\x00\xFF");
	    my @rgba = unpack "CCCC", $pix;
	    $currbyte <<= 1;
	    $currbits++;
	    if ($rgba[3] < 0x80) {
		if ($x < $w) {
		    $data->[$y*$w+$x] = undef;
		}
		$currbyte |= 1; # MS has the alpha channel inverted :-)
	    } else {
		# Might as well flip RGBA into BGR0 while we're here.
		if ($x < $w) {
		    $data->[$y*$w+$x] = pack "CCCC",
		      $rgba[2], $rgba[1], $rgba[0], 0;
		}
	    }
	    if ($currbits >= 8) {
		$alpha .= pack "C", $currbyte;
		$currbits -= 8;
	    }
	}
    }

    # For an 8-bit image, check we have at most 256 distinct
    # colours, and build the palette.
    %pal = ();
    if ($depth == 8) {
	my $palindex = 0;
	foreach $pix (@$data) {
	    next unless defined $pix;
	    $pal{$pix} = $palindex++ unless defined $pal{$pix};
	}
	die "too many colours in 8-bit image $filename\n" unless $palindex <= 256;
    } elsif ($depth == 4) {
	%pal = %win16pal;
    } elsif ($depth == 1) {
	%pal = %win2pal;
    }

    my $raster = "";
    if ($depth < 24) {
	# For a non-24-bit image, flatten the image into one palette
	# index per pixel.
	$pad = 32 / $depth; # number of pixels to pad scanline to 4-byte align
	$pmask = $pad-1;
	for ($y = 0; $y < $h; $y++) {
	    my $currbyte = 0, $currbits = 0;
	    for ($x = 0; $x < (($w+$pmask)|$pmask)-$pmask; $x++) {
		$currbyte <<= $depth;
		$currbits += $depth;
		if ($x < $w && defined ($pix = $data->[$y*$w+$x])) {
		    if (!defined $pal{$pix}) {
			die "illegal colour value $pix at pixel $i in $filename\n";
		    }
		    $currbyte |= $pal{$pix};
		}
		if ($currbits >= 8) {
		    $raster .= pack "C", $currbyte;
		    $currbits -= 8;
		}
	    }
	}
    } else {
	# For a 24-bit image, reverse the order of the R,G,B values
	# and stick a padding zero on the end.
	#
	# (In this loop we don't need to bother padding the
	# scanline out to a multiple of four bytes, because every
	# pixel takes four whole bytes anyway.)
	for ($i = 0; $i < scalar @$data; $i++) {
	    if (defined $data->[$i]) {
		$raster .= $data->[$i];
	    } else {
		$raster .= "\x00\x00\x00\x00";
	    }
	}
	$depth = 32; # and adjust this
    }

    # Prepare the icon data. First the header...
    my $data = pack "VVVvvVVVVVV",
      40, # size of bitmap info header
      $w, # icon width
      $h*2, # icon height (x2 to indicate the subsequent alpha channel)
      1, # 1 plane (common to all MS image formats)
      $depth, # bits per pixel
      0, # no compression
      length $raster, # image size
      0, 0, 0, 0; # resolution, colours used, colours important (ignored)
    # ... then the palette ...
    if ($depth <= 8) {
	my $ncols = (1 << $depth);
	my $palette = "\x00\x00\x00\x00" x $ncols;
	foreach $i (keys %pal) {
	    substr($palette, $pal{$i}*4, 4) = $i;
	}
	$data .= $palette;
    }
    # ... the raster data we already had ready ...
    $data .= $raster;
    # ... and the alpha channel we already had as well.
    $data .= $alpha;

    # Prepare the header which will represent this image in the
    # icon file.
    my $header = pack "CCCCvvV",
      $w, $h, # width and height (this time the real height)
      1 << $depth, # number of colours, if less than 256
      0, # reserved
      1, # planes
      $depth, # bits per pixel
      length $data; # size of real icon data

    push @hdr, $header;
    push @dat, $data;
}
Commit	Line	Data
fbd2dc51	1	#!/usr/bin/perl
fbd2dc51	2
7f7476c2	3	# Take a collection of input image files and convert them into a
7f7476c2	4	# multi-resolution Windows .ICO icon file.
fbd2dc51	5	#
7f7476c2	6	# The input images can be treated as having four different colour
7f7476c2	7	# depths:
fbd2dc51	8	#
7f7476c2	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.
fbd2dc51	14	#
7f7476c2	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).
fbd2dc51	48
7f7476c2	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).
fbd2dc51	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
7f7476c2	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
fbd2dc51	84	@hdr = ();
	85	@dat = ();
	86
7f7476c2	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	}
fbd2dc51	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 @_;
fbd2dc51	117	my $depth = shift @_;
	118	my $pix;
	119	my $i;
	120	my %pal;
	121
7f7476c2	122	# Determine the icon's width and height.
	123	my $w = `identify -format %w $filename`;
	124	my $h = `identify -format %h $filename`;
	125
fbd2dc51	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;
7f7476c2	189	} elsif ($depth == 1) {
7f7476c2	190	%pal = %win2pal;
fbd2dc51	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.
7f7476c2	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;
fbd2dc51	213	}
fbd2dc51	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.
7f7476c2	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.)
fbd2dc51	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	}