http://qs1969.pair.com?node_id=600763

A recent, very popular node, by eyepopslikeamosquito, intrigued me on a number of levels.  It was very well-written, quite entertaining, and contained fascinating details about Perl "golf".

But another thing caught my eye, which was the unique "miniature" graphics, the first of which was a silhouette of Santa Claus playing golf.  Looking at the source for the HTML quickly revealed that they were formed by using HTML <table> tags, and writing each pixel as a <td> element with the requisite background color.

Here's an example of an "image miniature":  

I don't know if this is a common technique, or if there are tools available for creating these images.  But I thought it would be fun to write a Perl script to do it.

One of the simplest graphic formats (supported by the amazing Gimp tool) is XPM.  This format maps one or more characters to a color, and then presents the necessary characters to display the full image.

It's quite easy with Gimp to convert just about any imaginable image format, be it .png, .jpg, .gif, or whatever, into .xpm format.

An aside -- if (like me) you're a user of the gvim editor, you may already be aware that gvim "renders" the appropriate colors for XPM image files during editing.  This lets you see the bitmap, in its full color, and edit individual pixels!

Here is the program I wrote, called "xpm2html.pl":

# Strict use strict; use warnings; # Libraries use Data::Dumper; use File::Basename; use readxpm; # Main program my $iam = basename $0; my $xpm = shift || die " syntax: $iam <xpm file> Reads an XPM image file, and converts it to an HTML file containing the same image, but composed of colored pixels within a HTML Table. "; ($xpm =~ /\.xpm$/i) or $xpm .= ".xpm"; my $out = $xpm; $out =~ s/\.xpm$/.html/i or die "$iam: invalid XPM '$xpm'\n"; my $p = new readxpm($xpm)->to_html($out); (-e $out) and print "Created HTML file '$out'\n";

It uses a Perl module called "readxpm.pm" (below), which parses the XPM data in the file, saving each color as an index within the object.  (Use pod2text on readxpm.pm for documentation).  It is by no means complete; it does attempt to make the resulting HTML code smaller, by combining successive columns of pixels of the same color (with colspan tags), but doesn't do the corresponding thing with successive same-colored rows.

Note that the resulting HTML code can take up a LOT of space!

A special "thanks" to the always-helpful ambrus, who quickly pointed out the fix to a bug I had in the to_html subroutine.

Here is "readxpm.pm":

package readxpm; # Strict use strict; use warnings; # Libraries use IO::File; # Subroutines sub new { my ($class, $fname) = @_; (ref $class) and $class = ref $class; # Create blessed reference my $self = { 'xpm' => 0 }; bless $self, $class; # Parse filename, if given if (defined $fname) { $self->{'xpm'} = $self->read($fname); } # Return the object return $self; } sub width { my ($self) = @_; (my $pxpm = $self->{'xpm'}) or return; return $pxpm->{'width'}; } sub height { my ($self) = @_; (my $pxpm = $self->{'xpm'}) or return; return $pxpm->{'height'}; } sub ncolors { my ($self) = @_; (my $pxpm = $self->{'xpm'}) or return; return $pxpm->{'ncolors'}; } sub colors { my ($self) = @_; (my $pxpm = $self->{'xpm'}) or return; return $pxpm->{'colors'}; } sub pixels { my ($self) = @_; (my $pxpm = $self->{'xpm'}) or return; return $pxpm->{'pixels'}; } # # sub read # # in: $1 ... filename of the XPM image. # # out: $1 ... a hash pointer with the following 5 keys # and values: # # 'width' ..... number of columns in the image # 'height' .... number of rows in the image # 'ncolors' ... number of pixel colors in the image # 'colors' .... an array mapping index to color # 'pixels' .... a 2-dimensional color index array # sub read { my ($self, $fname) = @_; # Read lines from .xpm file my $fh = new IO::File($fname) or die "Can't read '$fname' ($!)\n"; my $plines = [ ]; map { chomp; push @$plines, $_ } <$fh>; close $fh; # Discard header (' shift @$plines; # eg. '/* XPM */' shift @$plines; # eg. 'static char * my_xpm[] = {' # Get parameters (shift @$plines) =~ /(\d+)\s(\d+)\s(\d+)\s(\d+)/; my $pxpm = { width => $1, height => $2, ncolors => $3 }; my $charsize = $4; # Table for converting gray names to RGB my $p_gray_values = [qw( 00 03 05 08 0a 0d 0f 12 14 17 1a 1c 1f 21 24 26 29 2b 2e 30 33 36 38 3b 3d 40 42 45 47 4a 4d 4f 52 54 57 59 5c 5e 61 63 66 69 6b 6e 70 73 75 78 7a 7d 7f 82 85 87 8a 8c 8f 91 94 96 99 9c 9e a1 a3 a6 a8 ab ad b0 b3 b5 b8 ba bd bf c2 c4 c7 c9 cc cf d1 d4 d6 d9 db de e0 e3 e5 e8 eb ed f0 f2 f5 f7 fa fc )]; # Get color information my $pindex = { }; $pxpm->{'colors'} = [ ]; my $re = sprintf "^\"(.{%d})\\s+c\\s+#?(.+)\",", $charsize; for (my $i = 0; $i < $pxpm->{'ncolors'}; $i++) { my $line = shift @$plines; ($line =~ /$re/) or die "Invalid color line: '$line'\n"; my ($sym, $color) = ($1, lc $2); if ($color !~ /^[0-9a-f]{6}$/) { if ($color =~ /^(black|white|gr[ae]y100)$/) { $color = ($color eq 'black')? '000000': 'ffffff'; } elsif ($color eq 'none') { $color = 'none'; } elsif ($color =~ /^gr[ae]y(\d+){2}$/) { $color = $p_gray_values->[$1] x 3; } else { die "Unknown color name '$color'\n"; } } $pindex->{$sym} = $i; # Symbol to color index $pxpm->{'colors'}->[$i] = $color; # Color index to color } # Parse the pixel data $pxpm->{'pixels'} = [ ]; for (my $i = 0; $i < $pxpm->{'height'}; $i++) { my $prow = $pxpm->{'pixels'}->[$i] = [ ]; (my $line = shift @$plines) =~ s/^"//; for (my $j = 0; $j < $pxpm->{'width'}; $j++) { push @$prow, $pindex->{substr($line, 0, $charsize, "")}; } } return $pxpm; } sub to_html { my ($self, $fname) = @_; (my $pcolors = $self->colors) or return; (my $ppixels = $self->pixels) or return; (my $width = $self->width) or return; my $fh = new IO::File($fname, ">") or die "Can't write '$fname' ($ +!)\n"; print $fh "<!-- Created by readxpm (by John C. Norton) -->\n"; print $fh '<table cellpadding="0" cellspacing="0" border="0">', "\ +n"; printf $fh '<colgroup span="%d" width="1"></colgroup>', $width, "\ +n"; foreach my $prow (@$ppixels) { print $fh '<tr height="1">', "\n"; while (1) { last unless (@$prow > 0); my $pixel = shift @$prow; my $colspan = 1; while (@$prow > 0 and $prow->[0] eq $pixel) { shift @$prow; ++$colspan; } my $color = $pcolors->[$pixel]; print $fh ' <td'; printf $fh ' colspan="%d"', $colspan; printf $fh ' bgcolor="%s">', $color; print $fh "</td>\n"; } print $fh "</tr>\n"; } print $fh "</table>\n"; close $fh; } 1; __END__ =head1 NAME readxpm - Parses XPM image files =head1 SYNOPSIS use readxpm my $p = new readxpm("myimage.xpm"); my $pxpm = $p->xpm(); =head1 DESCRIPTION This module parses .xpm image files. For example, given an .xpm file called "dot.xpm", containing the follo +wing image (a yellow circle with a black border): /* XPM */ static char * dot_xpm[] = { "22 22 3 1", " c #FFFFFF", "# c #000000", "* c #FFF000", " ", " ######## ", " #********# ", " #**********# ", " #************# ", " #**************# ", " #****************# ", " #******************# ", " #******************# ", " #******************# ", " #******************# ", " #******************# ", " #******************# ", " #******************# ", " #******************# ", " #****************# ", " #**************# ", " #************# ", " #**********# ", " #********# ", " ######## ", " "} Then performing the following command: my $p = new readxpm("dot.xpm"); or: my $p = new readxpm(); $p->read("dot.xpm"); would parse the .xpm file to create the following hash reference: { 'width' => 22, 'height' => 22, 'ncolors' => 3, 'colors' => [ 'ffffff', '000000', 'fff000' ], 'pixels' => [ [ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ]; [ 0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0 ]; [ 0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0 ]; [ 0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0 ]; [ 0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0 ]; [ 0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0,0,0 ]; [ 0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0,0 ]; [ 0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0 ]; [ 0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0 ]; [ 0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0 ]; [ 0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0 ]; [ 0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0 ]; [ 0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0 ]; [ 0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0 ]; [ 0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0 ]; [ 0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0,0 ]; [ 0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0,0,0 ]; [ 0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0 ]; [ 0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0 ]; [ 0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0 ]; [ 0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0 ]; [ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ]; ], } $p->width $p->height $p->ncolors $p->colors $p->pixels =head2 Methods =over 4 =item I<PACKAGE>->new([I<filename>]) Creates a blessed readxpm object. If an XPM filename is given, it is +parsed. =item I<read>(I<filename>) Reads and parses the XPM image in the given filename. =item I<width>() Returns the width of the parsed XPM image. =item I<height>() Returns the height of the parsed XPM image. =item I<ncolors>() Returns the number of distinct colors in the parsed XPM image. =item I<colors>() Returns the table of colors (in RRGGBB format) of the parsed XPM image +. =item I<pixels>() Returns an array of arrays, representing the indices of the colors fro +m the XPM image. =item I<to_html>(I<filename>) Creates a filename with the html text necessary to render the XPM imag +e in a table. =back =head1 AUTHOR John C. Norton jcnorton@charter.net Copyright (c) 2007 John C. Norton. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 VERSION Version 1.000 (February 2007) =head1 SEE ALSO perl(1) =cut

s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/