1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 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 "$y $height $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 $!;
|