chiark / gitweb /
more complete rules
[xfonts-traditional] / update-xfonts-traditional
CommitLineData
18d2cc90
IJ
1#!/usr/bin/perl -w
2use strict;
3use POSIX;
4use IO::File;
a2d36db5 5use Getopt::Long;
18d2cc90 6
1b17f3ec 7our $prefix="/usr/local";
a2d36db5 8our $package='xfonts-traditional';
1b17f3ec
IJ
9our $sharedir="$prefix/share/$package";
10our @fontsdirs=qw(/usr/share/fonts/X11 /usr/local/share/fonts/X11);
a2d36db5
IJ
11our @rulespath;
12our $mode;
148a1d85
IJ
13our %foundrymap;
14our $verbose=0;
15our $reportfh;
16
17sub reportloaded {
18 return unless $verbose;
19 print $reportfh @_,"\n" or die $!;
20}
18d2cc90 21
4ee8efe0
IJ
22sub loadrules ($) {
23 my ($key) = @_;
18d2cc90 24 our %cache;
18d2cc90
IJ
25 my $fc=$cache{$key};
26 return $fc if $fc;
27 foreach my $path (@rulespath) {
28 my $script="$path/$key.rules";
29 $!=0; $@=''; my $f = do $script;
30 if (defined $f) {
148a1d85 31 reportloaded("rules: loaded ",$script);
18d2cc90
IJ
32 $cache{$key}=$f;
33 return $f;
34 }
35 die "$! $? $script" unless $! == &ENOENT;
36 }
37 return $cache{$key}=undef;
38}
39
148a1d85
IJ
40sub processbdf ($$$) {
41 my ($inbdf,$outbdf,$what) = @_;
4ee8efe0 42 my $state='idle';
148a1d85 43 my ($foundry,$font);
4ee8efe0 44 my ($w,$h,$xo,$yo,$y,$bitmap,$glyph);
148a1d85 45 my $modified=0;
18d2cc90
IJ
46 while (<$inbdf>) {
47 if ($state eq 'bitmap' && $y==$h) {
148a1d85
IJ
48 $glyph = uc $glyph;
49 $glyph =~ s/\;$//;
50 local ($_) = $glyph;
51 my $key= sprintf "%s,%d,%d,%d,%d", $foundry,$w,$h,$xo,$yo;
4ee8efe0 52 my $rules= loadrules($key);
148a1d85 53 return (0,'no rules') if !$rules;
18d2cc90 54 $rules->();
148a1d85 55 $modified += ($_ ne $glyph);
18d2cc90 56 print $outbdf $_,"\n" or die $!
4ee8efe0 57 foreach split /\;/, $_; # /;
18d2cc90
IJ
58 $state='idle';
59 }
60 if ($state eq 'bitmap') {
61 m/^([0-9a-fA-F]+)\s+$/ or die $y;
62 length($1) == (($w+7 >> 3) << 1) or die "$1 $w";
63 $glyph .= "$1;";
4ee8efe0
IJ
64 $y++;
65 next;
18d2cc90 66 }
4ee8efe0 67 if ($state eq 'idle' && m/^FOUNDRY\s+/) {
148a1d85
IJ
68 die if defined $foundry;
69 return (0,'foundry syntax') unless m/^FOUNDRY\s+\"(\w+)\"\s+/;
70 $foundry = $foundrymap{lc $1};
71 return (0,'no foundry') unless defined $foundry;
72 $_ = "FOUNDRY \"$foundry\"\n";
4ee8efe0
IJ
73 }
74 if ($state eq 'idle' && m/^FONT\s+/) {
148a1d85
IJ
75 die if defined $font;
76 return 0 unless m/^(FONT\s+)\-(\w+)\-/;
77 $font = $foundrymap{lc $2};
78 return (0,'no foundry') unless defined $font;
79 $_ = "FONT -$font-$'";
18d2cc90
IJ
80 }
81 if ($state eq 'idle' && m/^STARTCHAR\s/) {
148a1d85
IJ
82 die unless defined $foundry;
83 die unless defined $font;
84 return (0,'foundry != font') unless $foundry eq $font;
18d2cc90
IJ
85 $state='startchar';
86 $w=undef;
87 }
88 if ($state eq 'startchar') {
89 if (m/^BBX\s+(\+?\d+)\s+(\+?\d+)\s+([-+]?\d+)\s+([-+]?\d+)\s+$/) {
90 ($w,$h,$xo,$yo) = ($1,$2,$3,$4);
91 }
92 if (m/^BITMAP\s+$/) {
93 die unless defined $w;
94 $y=0;
95 $glyph='';
96 $state='bitmap';
97 }
98 }
4ee8efe0 99 print $outbdf $_ or die $!;
18d2cc90
IJ
100 }
101 die $! if $inbdf->error;
4ee8efe0 102 die $! if $outbdf->error or !$outbdf->flush;
18d2cc90 103 die unless $state eq 'idle';
148a1d85
IJ
104 if ($modified) {
105 printf $reportfh "%s: %d glyphs changed\n", $what, $modified
106 or die $!;
107 } else {
108 printf $reportfh "%s: unchanged - no rules matched\n", $what
109 or die $!;
110 }
111 return $modified;
18d2cc90
IJ
112}
113
a2d36db5
IJ
114our (@options)=(
115 'R|rules-include=s@' => \@rulespath,
116 'share-dir=s' => \$sharedir,
148a1d85 117 'verbose|v+' => \$verbose,
a2d36db5 118 );
4ee8efe0 119
a2d36db5
IJ
120sub define_mode ($$) {
121 my ($optname,$f) = @_;
122 push @options, $optname, sub {
123 die "only one mode may be specified\n" if defined $mode;
124 $mode=$f;
125 };
126}
127
148a1d85
IJ
128sub loadfoundries () {
129 foreach my $path (@rulespath) {
130 my $p = "$path/foundries";
131 my $f = new IO::File $p;
132 if (!$f) {
133 die "$p $!" unless $!==&ENOENT;
134 print $reportfh "foundries: none in $p\n" or die $! if $verbose;
135 next;
136 }
137 while (<$f>) {
138 s/^\s*//; s/\s+$//;
139 next if m/^\#/;
140 m/^(\w+)\s+(\w+)$/ or die;
141 my $k = lc $1;
142 next if exists $foundrymap{$k};
143 $foundrymap{$k}=$2;
144 }
145 $f->error and die $!;
146 reportloaded('foundries: loaded ',$p);
147 }
148 die "no foundry maps\n" unless %foundrymap;
149}
a2d36db5 150
148a1d85
IJ
151our $stdin = new IO::File '<&STDIN' or die $!;
152our $stdout = new IO::File '>&STDOUT' or die $!;
153our $stderr = new IO::File '>&STDERR' or die $!;
154$reportfh = $stdout;
155
156define_mode('bdf-filter', sub {
157 die "no arguments allowed with --bdf-filter\n" if @ARGV;
158 $reportfh = $stderr;
159 loadfoundries();
160 my $r = processbdf($stdin,$stdout,'stdin');
161 if ($r !~ m/^\d/) {
162 print STDERR "stdin not processed: $r\n";
163 exit 2;
164 }
a2d36db5
IJ
165});
166
167Getopt::Long::Configure(qw(bundling));
168GetOptions(@options) or exit 127;
169
db16069b 170push @rulespath, "$sharedir/rules";
a2d36db5
IJ
171
172die "need a mode\n" unless $mode;
173
174$mode->();
5f15b814
IJ
175
176# 70 zcat /usr/share/fonts/X11/misc/6x13.pcf.gz |pcf2bdf >in.bdf
177# 71 ./utility <in.bdf >out.bdf
178# 83 bdftopcf out.bdf >out.pcf
179# 84 gzip out.pcf
180# 85 cp out.pcf.gz /usr/share/fonts/X11/misc/
181# really mkfontdir /usr/share/fonts/X11/misc/
182# xset fp rehash
183# xfontsel