#!/usr/bin/perl
# Uniset -- Unicode subset manager -- Markus Kuhn <mkuhn@acm.org>

print <<End if $#ARGV < 0;
Uniset 1.0 -- Unicode subset manager -- Markus Kuhn <mkuhn\@acm.org>

Uniset allows to merge and subtract Unicode subsets. It can output and
analyse the resulting set in various formats.

The following commands can be supplied to uniset on the command line:

Commands to define a set of characters:

  +filename    add the character set described in the file to the set
  -filename    remove the character set described in the file from the set
  +xxxx-yyyy   add the range to the set (xxxx and yyyy are hex numbers)
  -xxxx-yyyy   remove the range to the set (xxxx and yyyy are hex numbers)
  clean        remove any elements that do not appear in the Unicode database

Command to output descriptions of the constructed set of characters:

  table        write a full table with one line per character
  compact      output the set in compact MES format
  nr           output the number of characters
  sources      output a table that shows the number of characters contributed
               by the various combinations of input sets added with +.

Commands to tailor the following output commands:

  html         write HTML tables instead of plain text
  img          write HTML tables and include a GIF image for every entry
  imgblock     write a block of GIFs in HTML format
  ucs          add the unicode character itself to the table (UTF-8 in
               plain table, numeric character reference in HTML)

Auxiliary commands:

  loadimages   download a GIF image for every character in the set from
               <http://charts.unicode.org/Unicode.charts/Small.Glyphs/xx/
               Uxxyy.gif> where xxyy is the uppercase hexadecimal number
               of the character. This command requires the "webcopy"
               script to be installed, which is available from
               <ftp://ftp.inf.utfsm.cl/pub/utfsm/perl/webcopy.tgz>.

Formats of character set input files read by the + and - command:

Empty lines, while space at the start and end of the line and any
comment text following a \# are ignored. The following formats are
recognized

xx yyyy             xx is the hex code in an 8-bit character set and yyyy
                    is the corresponding Unicode value. Both can optionally
                    be prefixed by 0x. This is the format used in the
                    files on <ftp://ftp.unicode.org/Public/MAPPINGS/>.

yyyy                yyyy (optionally prefixed with 0x) is a Unicode character
                    belonging to the specified subset.

yyyy-yyyy           a range of Unicode characters belonging to
                    the specified subset.

xx yy yy yy-yy yy   xx denotes a row (high-byte) and the yy specify
                    corresponding low bytes or with a hyphen also ranges of
                    low bytes in the Unicode values that belong to this
                    subset. This is also the format that is generated by
                    the compact command.
End
exit 1 if $#ARGV < 0;

$html = 0;
$image = 0;
$ucs = 0;
$unicodedata = "UnicodeData-Latest.txt";

# read list of all Unicode names
if (!open(UDATA, $unicodedata) && !open(UDATA, "/homes/mgk25/proj/unicode/UnicodeData-Latest.txt")) {
    die ("Can't open Unicode database '$unicodedata':\n$!\n\n" .
	 "Please make sure that you have downloaded the file\n" .
	 "ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData-Latest.txt\n");
}
while (<UDATA>) {
    if (/^([0-9,A-F]{4});([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*)$/) {
        $name{$1} = $2;
	$invname{$2} = $1;
        $comment{$1} = $12;
    } else {
        die("Syntax error in line '$_' in file '$unicodedata'");
    }
}

while (<UDATA>) {
    /^([0-9,A-F]{4});([^;]*);.*/;
    $name{$1} = $2;
}

while ($_ = shift(@ARGV)) {
    if (/^html$/) {
	$html = 1;
    } elsif (/^img$/) {
	$html = 1;
	$image = 1;
    } elsif (/^template$/) {
	$template = shift(@ARGV);
	open(TEMPLATE, $template) || die("Can't open template file '$template': '$!'");
	while (<TEMPLATE>) {
	    if (/^\#\s*include\s+\"([^\"]*)\"\s*$/) {
		open(INCLUDE, $1) || die("Can't open template include file '$1': '$!'");
		while (<INCLUDE>) {
		    print $_;
		}
		close(INCLUDE);
	    } elsif (/^\#\s*quote\s+\"([^\"]*)\"\s*$/) {
		open(INCLUDE, $1) || die("Can't open template include file '$1': '$!'");
		while (<INCLUDE>) {
		    s/&/&amp;/g;
		    s/</&lt;/g;
		    print $_;
		}
		close(INCLUDE);
	    } else {
		print $_;
	    }
	}
	close(TEMPLATE);
    } elsif (/^([+-])(.*)/) {
	push(@SETS, $_);
	$remove = $1 eq "-";
	$setfile = $2;
	if ($setfile =~ /^([0-9A-Fa-f]{4})-([0-9A-Fa-f]{4})$/) {
	    # handle intervall specification on command line
	    $first = hex($1);
	    $last = hex($2);
	    for ($i = $first; $i <= $last; $i++) {
		$used{sprintf("%04X", $i)} .= "[ARG]" unless $remove;
		delete $used{sprintf("%04X", $i)} if $remove;
	    }
	    next;
	}
	open(SET, $setfile) || die("Can't open set file '$setfile': '$!'");
	$cedf = ($setfile =~ /cedf/); # detect Kosta Kosti's trans CEDF format by path name
	$setname = $setfile;
	$setname =~ s/([^.\[\]]*)\..*/$1/;
	while (<SET>) {
	    if (/^<code_set_name>/) {
		# handle ISO 15897 (POSIX registry) charset mapping format
		undef $comment_char;
		undef $escape_char;
		while (<SET>) {
		    if ($comment_char && /^$comment_char/) {
			# remove comments
			$_ = $`;
		    }
		    next if (/^\032?\s*$/);                                             # skip empty lines
		    if (/^<comment_char> (\S)$/) {
			$comment_char = $1;
		    } elsif (/^<escape_char> (\S)$/) {
			$escape_char = $1;
		    } elsif (/^(END )?CHARMAP$/) {
			#ignore
		    } elsif (/^<.*>\s*\/x([0-9A-F]{2})\s*<U([0-9A-F]{4})>/) {
			$used{$2} .= "[${setname}{$1}]" unless $remove;
			delete $used{$2} if $remove;
		    } else {
			die("Syntax error in line $. in file '$setfile':\n'$_'\n");
		    }
		}
		next;
	    } elsif (/^STARTFONT /) {
		# handle X11 BDF file
		while (<SET>) {
		    if (/^ENCODING\s+([0-9]+)/) { 
			$unicode = sprintf("%04X",$1);
			$used{$unicode} .= "[${setname}]" unless $remove;
			delete $used{$unicode} if $remove;
		    }
		}
		next;
	    }
	    tr/a-z/A-Z/;           # make input uppercase
	    if ($cedf) {
		if ($. > 4) {
		    if (/^([0-9A-F]{2})\t.?\t(.*)$/) {
			# handle Kosta Kosti's trans CEDF format
			next if (hex($1) < 32 || (hex($1) > 0x7e && hex($1) < 0xa0));
			$unicode = $invname{$2};
			die "unknown ISO 10646 name '$2' in '$setfile' line $..\n" if ! $unicode;
			$used{$unicode} .= "[${setname}{$1}]" unless $remove;
			delete $used{$unicode} if $remove;
		    } else {
			die("Syntax error in line $. in CEDF file '$setfile':\n'$_'\n");
		    }
		}
		next;
	    }
	    if (/^\s*(0X|U\+|U-)?([0-9A-F]{2})\s+\#\s*UNDEFINED\s*$/) {
		# ignore ftp.unicode.org mapping file lines with #UNDEFINED
		next;
	    }
	    s/^([^\#]*)\#.*$/$1/;  # remove comments
	    next if (/^\032?\s*$/);     # skip empty lines
	    if (/^\s*(0X)?([0-9A-F]{2})\s+(0X|U\+|U-)?([0-9A-F]{4})\s*$/) {
		# handle entry from a ftp.unicode.org mapping file
		$used{$4} .= "[${setname}{$2}]" unless $remove;
		delete $used{$4} if $remove;
	    } elsif (/^\s*(0X|U\+|U-)?([0-9A-F]{4})(\s*-\s*|\s*\.\.\s*|\s+)(0X|U\+|U-)?([0-9A-F]{4})\s*$/) {
		# handle interval specification
		$first = hex($2);
		$last = hex($5);
		for ($i = $first; $i <= $last; $i++) {
		    $used{sprintf("%04X", $i)} .= "[${setname}]" unless $remove;
		    delete $used{sprintf("%04X", $i)} if $remove;
		}
	    } elsif (/^\s*(0X|U\+|U-)?([0-9A-F]{4})\s*/) {
		# handle single character
		$used{$2} .= "[${setname}]" unless $remove;
		delete $used{$2} if $remove;
	    } elsif (/^\s*([0-9A-F]{2})(\s+[0-9A-F]{2},?|\s+[0-9A-F]{2}-[0-9A-F]{2},?)+/) {
		# handle lines from P10 MES draft
		$row = $1;
		$cols = $_;
		$cols =~ s/^\s*([0-9A-F]{2})\s*(.*)\s*$/$2/;
		$cols =~ tr/,//d;
		@cols = split(/\s+/, $cols);
		for (@cols) {
		    if (/^(..)$/) {
			$first = hex("$row$1");
			$last  = $first;
		    } elsif (/^(..)-(..)$/) {
			$first = hex("$row$1");
			$last  = hex("$row$2");
		    } else {
			die ("this should never happen '$_'");
		    }
		    for ($i = $first; $i <= $last; $i++) {
			$used{sprintf("%04X", $i)} .= "[${setname}]" unless $remove;
			delete $used{sprintf("%04X", $i)} if $remove;
		    }
		}
	    } else {
		die("Syntax error in line $. in file '$setfile':\n'$_'\n") unless /^\s*(\#.*)?$/;
	    }
	}
	close SET;
    } elsif (/^loadimages$/ || /^loadbigimages$/) {
	if (/^loadimages$/) {
	    $prefix = "Small.Glyphs";
	} else {
	    $prefix = "Glyphs";
	}
	$total = 0;
	for $i (keys(%used)) {
	    next if ($name{$i} eq "<control>");
	    $total++;
	}
	$count = 0;
	$| = 1;
	for $i (sort(keys(%used))) {
	    next if ($name{$i} eq "<control>");
	    $count++;
	    $j = $i;
	    $j =~ s/(..)(..)/$1/;
	    $gif = "http://charts.unicode.org/Unicode.charts/$prefix/$j/U$i.gif";
	    print("\r$count/$total: $gif");
	    system("mkdir -p $prefix/$j; cd $prefix/$j; webcopy -u -s $gif &");
	    select(undef, undef, undef, 0.2);
	}
	print("\n");
	exit 0;
    } elsif (/^giftable/) {
	# form a table of glyphs (requires pbmtools installed)
	$count = 0;
	for $i (keys(%used)) {
	    $count++ unless $name{$i} eq "<control>";
	}
	$width = int(sqrt($count/sqrt(2)) + 0.5);
	$width = $1 if /^giftable([0-9]+)$/;
	system("rm -f tmp-*.pnm table.pnm~ table.pnm");
	$col = 0;
	$row = 0;
	for $i (sort(keys(%used))) {
	    next if ($name{$i} eq "<control>");
	    $j = $i;
	    $j =~ s/(..)(..)/$1/;
	    $gif = "Small.Glyphs/$j/U$i.gif";
	    $pnm = sprintf("tmp-%02x.pnm", $col);
	    $fallback = "Small.Glyphs/FF/UFFFD.gif";
	    system("giftopnm $gif >$pnm || { rm $pnm ; giftopnm $fallback >$pnm ; }");
	    if (++$col == $width) {
		system("pnmcat -lr tmp-*.pnm | cat >tmp-row.pnm");
		if ($row == 0) {
		    system("mv tmp-row.pnm table.pnm");
		} else {
		    system("mv table.pnm table.pnm~; pnmcat -tb table.pnm~ tmp-row.pnm >table.pnm");
		}
		$row++;
		$col = 0;
		system("rm -f tmp-*.pnm table.pnm~");
	    }
	}
	if ($col > 0) {
	    system("pnmcat -lr tmp-*.pnm | cat >tmp-row.pnm");
	    if ($row == 0) {
		system("mv tmp-row.pnm table.pnm");
	    } else {
		system("mv table.pnm table.pnm~; pnmcat -tb -jleft -black table.pnm~ tmp-row.pnm >table.pnm");
	    }
	}
	system("rm -f table.gif ; ppmtogif table.pnm > table.gif");
	system("rm -f tmp-*.pnm table.pnm~ table.pnm");
    } elsif (/^table$/) {
	# go through all used names to print full table
	print "<TABLE border=2>\n" if $html;
	for $i (sort(keys(%used))) {
	    next if ($name{$i} eq "<control>");
	    if ($html) {
		$sources = $used{$i};
		$sources =~ s/\]\[/, /g;
		$sources =~ s/^\[//g;
		$sources =~ s/\]$//g;
		$sources =~ s/\{(..)\}/<SUB>$1<\/SUB>/g;
		$j = $i;
		$j =~ s/(..)(..)/$1/;
		$gif = "Small.Glyphs/$j/U$i.gif";
		print "<TR>";
		print "<TD><img width=32 height=32 src=\"$gif\">" if $image;
		print "<TD><SAMP>$i</SAMP><TD><SAMP>$name{$i}";
		print " ($comment{$i})" if $comment{$i};
		print "</SAMP><TD><SMALL>$sources</SMALL>\n";
	    } else {
		print "$i # $name{$i}\n";
	    }
	}
	print "</TABLE>\n" if $html;
    } elsif (/^imgblock$/) {
	$width = 16;
	$width = $1 if /giftable([0-9]+)/;
	$col = 0;
	$subline = "";
	print "\n<P><TABLE cellspacing=0 cellpadding=0>";
	for $i (sort(keys(%used))) {
	    print "<TR>" if $col == 0;
	    $j = $i;
	    $j =~ s/(..)(..)/$1/;
	    $gif = "Small.Glyphs/$j/U$i.gif";
	    $alt = "$name{$i}";
	    print "<TD><img width=32 height=32 src=\"$gif\" alt=\"$alt\">";
	    $subline .= "<TD><SMALL><SAMP>$i</SAMP></SMALL>";
	    if (++$col == $width) {
		print "<TR align=center>$subline";
		$col = 0;
		$subline = "";
	    }
	}
	print "<TR align=center>$subline" if ($col > 0);
	print "</TABLE>\n";
    } elsif (/^sources$/) {
	# count how many characters are attributed to the various source set combinations
	print "<P>Number of occurences of source character set combinations:\n<TABLE border=2>" if $html;
	for $i (keys(%used)) {
	    next if ($name{$i} eq "<control>");
	    $sources = $used{$i};
	    $sources =~ s/\]\[/, /g;
	    $sources =~ s/^\[//g;
	    $sources =~ s/\]$//g;
	    $sources =~ s/\{(..)\}//g;
	    $contribs{$sources} += 1;
	}
	for $j (keys(%contribs)) {
	    print "<TR><TD>$contribs{$j}<TD>$j\n" if $html;
	}
	print "</TABLE>\n" if $html;
    } elsif (/^compact$/) {
	# print compact table in P10 MES format
	print "<P>Compact representation of this character set:\n<TABLE border=2>" if $html;
	print "<TR><TD><B>Rows</B><TD><B>Positions (Cells)</B>" if $html;
	print "\n# Plane 00\n# Rows\tPositions (Cells)\n" unless $html;
	$current_row = '';
	$start_col = '';
	$last_col = '';
	for $i (sort(keys(%used))) {
	    next if ($name{$i} eq "<control>");
	    $row = substr($i, 0, 2);
	    $col = substr($i, 2, 2);
	    if ($row ne $current_row) {
		if (($last_col ne '') and ($last_col ne $start_col)) {
		    print "-$last_col";
		    print "</SAMP>" if $html;
		}
		print "<TR><TD><SAMP>$row</SAMP><TD><SAMP>" if $html;
		print "\n  $row\t" unless $html;
		$len = 0;
		$current_row = $row;
		$start_col = '';
	    }
	    if ($start_col eq '') {
		print "$col";
		$len += 2;
		$start_col = $col;
		$last_col = $col;
	    } elsif (hex($col) == hex($last_col) + 1) {
		$last_col = $col;
	    } else {
		if ($last_col ne $start_col) {
		    print "-$last_col";
		    $len += 3;
		}
		if ($len > 60 && !$html) {
		    print "\n  $row\t";
		    $len = 0;
		};
		print " " if $len;
		print "$col";
		$len += 2 + !! $len;
		$start_col = $col;
		$last_col = $col;
	    }
	}
	if (($last_col ne '') and ($last_col ne $start_col)) {
	    print "-$last_col";
	    print "</SAMP>" if $html;
	}
	print "\n" if ($current_row ne '');
	print "</TABLE>\n" if $html;
	print "\n";
    } elsif (/^nr$/) {
	print "<P>" if $html;
	print "# " unless $html;
	print "Number of characters in above table: ";
	$count = 0;
	for $i (keys(%used)) {
	    $count++ unless $name{$i} eq "<control>";
	}
	print $count;
	print "\n";
    } elsif (/^clean$/) {
	# remove characters from set that are not in $unicodedata
	for $i (keys(%used)) {
	    delete $used{$i} unless $name{$i};
	}
    } else {
	die("Unknown command line command '$_'");
    };
}
