chiark / gitweb /
better about when to update fonts.dir
[xfonts-traditional] / printrule
CommitLineData
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
15use strict;
16use IO::File;
17
18die unless @ARGV==6;
19our ($badf,$goodf,$height,$regexp,$partial,$comment) = @ARGV;
20
21sub 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
40my $bad = get($badf);
41my $good = get($goodf);
42my $s;
43if ($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}
51printf " %s; # %s\n", $s, $comment or die $!;