#!/usr/bin/perl -w # usage: # printrule bad.bdf good.bdf '^ENCODING $' 0|1 # printrule bad.bdf good.bdf '^STARTCHAR $' 0|1 # 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 $!;