http://www.perlmonks.org?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";

[download]

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

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

Replies are listed 'Best First'.
Re: Add "Image Miniatures" to your HTML
by jdporter (Paladin) on Feb 19, 2007 at 15:29 UTC

    Please DO NOT frivolously Add "Image Miniatures" to your HTML, at least here on PerlMonks. They consume an inordinate about of storage/transmission resources. It would be almost better to turn on image linking than to have people doing this to any extent. (I say "almost" because image linking has plenty of downsides too. At least with this "image miniatures" technique images are limited to something considerably less than 64k in size.)

    It's cute, but it's wasteful. Thanks in advance.

    A word spoken in Mind will reach its own level, in the objective world, by its own weight
[reply]
Re: Add "Image Miniatures" to your HTML (Fun References)
by eyepopslikeamosquito (Archbishop) on Feb 19, 2007 at 20:07 UTC
[reply]
[d/l]
[select]
Re: Add "Image Miniatures" to your HTML
by merlyn (Sage) on Feb 19, 2007 at 01:56 UTC
[reply]
      <laugh type="mwahahah">Avoiding such comments is the exact motivation that prevented me to publish a more or less similar script for HTML table images (I've put one of those images in my homenode btw).</laugh>

      Jokes apart, I was stopped by a comment in IRC channel #linux-it (in Italian, on Freenode) pointing out that GIMP does this "from ages". It would be interesting to understand if you did it before GIMP, so that I can reply "Yeah? well, merlyn does this from more ages!".

      Flavio
      perl -ple'$_=reverse' <<<ti.xittelop@oivalf

      Don't fool yourself.
[reply]
Re: Add "Image Miniatures" to your HTML
by zentara (Archbishop) on Feb 19, 2007 at 13:58 UTC
    The only problem with these images is that they don't always show up. I have my browser to ignore colors and use my chosen color set, and the image is invisible to me.
    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]
      The other problem is that this technique uses a language for marking up text in a device/presentation indenpendent fashion for presentation.
[reply]
Re: Add "Image Miniatures" to your HTML
by hossman (Prior) on Feb 22, 2007 at 08:26 UTC

    There is absolutely, positively, no legitimate reason to encode an image as an HTML table.

    This is why we have RFC RFC 2397 and the data: URL schema 

    <img src="data:image/x-icon;base64,AAABAAIAEBAQAAAAAAAoAQAAJgAAACAgEAA
+AAAAA6AIAAE4BAAAoAAAAEAAAACAAAAABAAQAAAAAAMAAAAAAAAAAAAAAABAAAAAAAAAA
+AAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwACAgIAAAAD/AAD/AAAA//8A/wAAA
+P8A/wD//wAA////AMzMzMzMzMzMz8zM///PzPzPzMz8zM/M/M//zP//z8z8z8z8/M/PzP
+zPzPzP/8/8/M/M/MzMzMz8z//8zMzMzPzMzMzMzMzMzP/wgICAj/gA//iI+ICP//BwCHe
+AAA///4h/cAeI////8ICAeIj///////iIj////////3j/////AAD//wAA//8AAP//AAD/
+/wAA//8AAP//AAD//wAA//8AAP//AAD//wAA//8AAP//AAD//wAA//8AAP//AAD//ygAA
+AAgAAAAQAAAAAEABAAAAAAAgAIAAAAAAAAAAAAAEAAAAAAAAAAAAAAABAQEAIyMjAD8ND
+QAREREAOLi4gA8PDwAvb29ABYWFgBsbGwA/Pz8AJycnAB8fHwADAwMAJSUlAD///8Aqqq
+qpBGLnMdbV1WclJiBTKqqql0RiJV+m5dVybRIgW6qqqWYjYTleZvqd+nGQYGcMzMzMzMz
+MzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzM6ozMzMzMzqqqjM6ozM6ozOqMzMzMzOqMzq
+jOqMzOqMzqjMzMzM6ozMzqjqjMzqjM6ozMzMzOqMzMzM6ozM6ozOqqqqqMzqqqqqqOqMz
+OqMzqqqqqqM6ozMzqjqjMzqjM6ozMzqqM6ozOqM6qjM6ozOqMzMzqjM6qqozOqOqOqMzq
+jMzM6ozMzMzMzMzMzqjM6ozMzqjMzMzMzMzMzM6ozOqqqqqMzMzMzMzMzMzOqMzMzMzMz
+MzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzqqqqWNQYmRGETRmqqqkRHaqqqqmOyXeIR
+kGJqqqqdBGqqqqkiZt1dESI6Vqqqqrhqld7gUlJpXQURERaqqqqp6dBHUmnl1vmjYgYWq
+qqqqqp7Ll1p3yNTpQRh6qqqqqqpE5XVae4GGeUjJqqqqqqqq4Umc7lQUxESEWaqqqqqqq
+qzYm2TBHH7E5JuqqqqqqqqqlLfuSJl+GJR6qqqqqqqqqqqqqq5IRkS+Wqqqqqqqqqqqqq
+qqqYgY5aqqqqqqqqqqqqqqqqV5x6qqqqqqqqqqqqqqqqqqpaqqqqqqqqqqoAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAA=="/>

    [download]
[reply]
[d/l]
[select]
      There is absolutely, positively, no legitimate reason to encode an image as an HTML table.

      Perhaps you've noticed that Perl Monks Approved HTML tags lists "table" (etc.) but does not list "img"? (Not that I consider posting HTML-table pictures at PerlMonks a wise idea.)

      Thanks for the demonstration of the data: URL.

      - tye        

[reply]

        As I said: "no legitimate reason"

        Beyond being "unwise", circumventing the list of approved HTML tags on Perl Monks (or any community orriented site) isn't what I would consider a "legitimate" reason.

[reply]
      This is why we have RFC 2397 and the data: URL schema

      Whoa, thank you for pointing out, because I didn't know. But then, there's diotalevi's JS trick available from his homenode too.

[reply]

Back to Cool Uses for Perl