Commit | Line | Data |
---|---|---|
15fc3ba1 IJ |
1 | #!/usr/bin/perl -w |
2 | # usage: | |
3 | # printrule bad.bdf good.bdf <height> '^ENCODING <nn>$' 0|1 <comment> | |
4 | # printrule bad.bdf good.bdf <height> '^STARTCHAR <name>$' 0|1 <comment> | |
5 | ||
6 | # This script is an assistant for printing rules for pasting into | |
7 | # *.rules files. The idea is that you get bdfs of the font you don't | |
8 | # and do like, and specify the character, and it will print a rule | |
9 | # that fixes it. | |
10 | # | |
11 | # Final argument, if 1, says the glyph is a letter without an | |
12 | # ascender, and edits the regexp not to match the whitespace where | |
13 | # accents might go. | |
14 | ||
15 | use strict; | |
16 | use IO::File; | |
17 | ||
18 | die unless @ARGV==6; | |
19 | our ($badf,$goodf,$height,$regexp,$partial,$comment) = @ARGV; | |
20 | ||
21 | sub get ($) { | |
22 | my ($p) = @_; | |
23 | my $f = new IO::File $p or die "$p $!"; | |
24 | while (<$f>) { | |
25 | last if m/$regexp/o; | |
26 | } | |
27 | die $p unless defined; | |
28 | while (<$f>) { | |
29 | last if m/^BITMAP$/; | |
30 | } | |
31 | my $glyph=''; | |
32 | for (my $y=0; $y<$height; $y++) { | |
33 | <$f> =~ m/^([0-9a-f]+)$/i or die "$p $_ ?"; | |
34 | $glyph.="$1;"; | |
35 | } | |
36 | $glyph =~ s/\;$//; | |
37 | return $glyph; | |
38 | } | |
39 | ||
40 | my $bad = get($badf); | |
41 | my $good = get($goodf); | |
42 | my $s; | |
43 | if ($partial) { | |
44 | $bad =~ s/^(?:00\;)+//; my $badrm= $&; | |
45 | $good =~ s/^(?:00\;)+//; my $goodrm= $&; | |
46 | die "$badrm $bad $goodrm $good " unless $badrm eq $goodrm; | |
47 | $s = sprintf 's/\\b%s$/%s/', $bad, $good; | |
48 | } else { | |
49 | $s = sprintf 's/^%s$/%s/', $bad, $good; | |
50 | } | |
51 | printf " %s; # %s\n", $s, $comment or die $!; |