#!/usr/bin/perl -- # -*- Mode: perl; tab-width:4 -*-
#========================================================================
#c# Released into the public domain 09/29/02 - knock yerself out.
#------------------------------------------------------------------------
#
# Name: asciify-html
#
# Author: Steven Champeon
#
# Maintainer: same
#
# Version: 1.0
# Version History:
#   1.1 - 09/16/02 - first cut
#  
# Dependencies:
#
# Purpose:
#  Take in an XPM file and generate HTML/CSS ASCII art from the image
#
# Note: to convert to XPM from any format, use ImageMagick
#  e.g: convert filename.ext filename.xpm
#
# Usage:
#  asciify-html < some.xpm > some.html
#
#------------------------------------------------------------------------

my %map;
my %xwk;
my %pix;
my %rgb;
my $rgbdottxt = "/usr/share/emacs/20.7/etc/rgb.txt";
my $css = qq'div {
font: bold small-caps 8px/4px "Andale Mono";
white-space: pre;
}
span {
margin: 0px 0px 0px 0px;
padding: 0px 0px 0px 0px;
}
' . "\n";
my $div;

my $w = 128; # width
my $h = 96;  # height (reasonable defaults)
my $c = 256; # colors
my $d = 2;   # depth
my $len = $w * $d; # length of line
my $cnt = 0;
my $verbose = 0;
my $notset = 1;

# get X11 color names and map to rgb space
open(RGB, $rgbdottxt) or die "no rgb.txt!";
while(<RGB>) {
	chomp;
	next if(/^\#/ || /^$/);
	if(/\s*(\d+)\s+(\d+)\s+(\d+)\s+(.*)/) {
		my $key = lc($4);
		my $R = $1;	my $G = $2;	my $B = $3;
		$rgb{$key} = sprintf("\#%02x%02x%02x", $R, $G, $B);
		print STDERR "added $key to rgb for $R/$G/$B\n" if($verbose);
	}
}
close(RGB);

while(<>) {
	chomp;
	if(/^\/\*/) { # skip comments (xpm comments are on one line)
		print STDERR "skipping comment\n" if($verbose);
	}
	if(/^static/) { # skip 
		print STDERR "skipping static decl\n" if($verbose);
	}
	if(/^\s*\}\;/) { # the end
		print STDERR "reached the end\n" if($verbose);
	}
	if(/^\"(\d+) (\d+) (\d+) (\d+)/ && $notset) {
		$w = $1; $h = $2; $c = $3; $d = $4;
		$len = $w * $d;
		if($verbose) {
			print STDERR "setting width to $w; height to $h, colors to $c,\n";
			print STDERR "depth to $d; making len $len.\n";
		}
		$notset = 0;
		next;
	}
	if(/^\"(.{$d})\s+c (\#\w{6})\",?/) {
		$xwk{$1} = $2; # crosswalk of XPM identifier to color
		print STDERR "added $2 to xwk ($1)\n" if($verbose);
		next;
	}
	# handle X11 color name case
	if(/^\"(.{$d})\s+c (.*)\",?/) {
		my $x11rgb = lc($2);
		$xwk{$1} = $rgb{$x11rgb}; # crosswalk of XPM identifier to color
		print STDERR "added $2 to xwk ($1)\n" if($verbose);
		next;
	}
	if(/^\"(.{$len})\",?/) {
		my $tmpkey = sprintf("%03d", $cnt++);
		$pix{$tmpkey} = $1;
		print STDERR "added line for $cnt, len ", length($1), "\n$1\n" if($verbose);
		next;
	}
}

# loop through xwalk, create map and print css
my $key, $newkey;
foreach $key (sort keys %xwk) { # key is now old xpm id (e.g., 'A,')
	$newkey = getalphanumkey($key); # newkey is now new all-hex id ('FbA1')
	$map{$newkey} = $xwk{$key};
	$map{$key} = $newkey; # which is to say map{A,} => 'FbA1'
	$css .= sprintf(".x%s{background-color:%s;color:%s}\n",
					$newkey,    # css identifier
					$xwk{$key}, # background color
					$xwk{$key}  # color
					);
}

# print header
print STDOUT<<"END";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">

<html xmlns="http://www.w3.org/1999/xhtml" lang="en">
<head>
<title></title>
END

# print style
print STDOUT '<style type="text/css">', "\n", $css, "</style>\n";

print STDOUT<<"END";
</head>
<body>
<div>
END

# loop through pix and create individual spans using map
my $line, $pixel;
foreach $line (sort keys %pix) {
	my @pixels = split(//, $pix{$line});
	my $thiskey = '';
	my $lastkey = '';
	for(my $i = 0; $i <= $#pixels; $i += $d) {
		my $tmp = '';
		for(my $j = 0; $j < $d; $j++) {
			$tmp .= "$pixels[$i+$j]"; # e.g., 'A,'
		}
		$thiskey = $map{$tmp};
		if($lastkey eq $thiskey) {
			print STDOUT '#';
		} elsif($i == 0) {
			printf STDOUT '<span class="x%s">#', $thiskey;
		} else {
			print  STDOUT "</span>";
			printf STDOUT '<span class="x%s">#', $thiskey;
		}
		$lastkey = $thiskey;
	}
	print STDOUT "</span><br />\n";
}

# close div
print STDOUT "</div>\n</body></html>\n";

sub getalphanumkey {
	my $longkey = shift;
	$longkey =~ /^(.{$d})$/;
	my @bytes = split(//, $1);
	my $tmp = '';
	for(my $j = 0; $j < $d; $j++) {
		$tmp .= sprintf("%02x", (ord($bytes[$j])-31));
	}
	return $tmp;
}
