rule generation machinery

[xfonts-traditional] / printrule

diff --git a/printrule b/printrule
new file mode 100755 (executable)
index 0000000..4c16d9b
--- /dev/null
+++ b/printrule
@@ -0,0 +1,51 @@
+#!/usr/bin/perl -w
+# usage:
+#  printrule bad.bdf good.bdf <height> '^ENCODING <nn>$' 0|1 <comment>
+#  printrule bad.bdf good.bdf <height> '^STARTCHAR <name>$' 0|1 <comment>
+
+# This script is an assistant for printing rules for pasting into
+# *.rules files.  The idea is that you get bdfs of the font you don't
+# and do like, and specify the character, and it will print a rule
+# that fixes it.  
+#
+# Final argument, if 1, says the glyph is a letter without an
+# ascender, and edits the regexp not to match the whitespace where
+# accents might go.
+
+use strict;
+use IO::File;
+
+die unless @ARGV==6;
+our ($badf,$goodf,$height,$regexp,$partial,$comment) = @ARGV;
+
+sub get ($) {
+    my ($p) = @_;
+    my $f = new IO::File $p or die "$p $!";
+    while (<$f>) {
+       last if m/$regexp/o;
+    }
+    die $p unless defined;
+    while (<$f>) {
+       last if m/^BITMAP$/;
+    }
+    my $glyph='';
+    for (my $y=0; $y<$height; $y++) {
+       <$f> =~ m/^([0-9a-f]+)$/i or die "$p $_ ?";
+       $glyph.="$1;";
+    }
+    $glyph =~ s/\;$//;
+    return $glyph;
+}
+
+my $bad = get($badf);
+my $good = get($goodf);
+my $s;
+if ($partial) {
+    $bad  =~ s/^(?:00\;)+//;  my $badrm= $&;
+    $good =~ s/^(?:00\;)+//;  my $goodrm= $&;
+    die "$badrm $bad   $goodrm $good " unless $badrm eq $goodrm;
+    $s = sprintf 's/\\b%s$/%s/', $bad, $good;
+} else {    
+    $s = sprintf 's/^%s$/%s/', $bad, $good;
+}
+printf "    %s; # %s\n", $s, $comment or die $!;