chiark / gitweb /
runes
[xfonts-traditional] / utility
CommitLineData
18d2cc90
IJ
1#!/usr/bin/perl -w
2use strict;
3use POSIX;
4use IO::File;
5
6our @rulespath=('.');
7
4ee8efe0
IJ
8sub loadrules ($) {
9 my ($key) = @_;
18d2cc90 10 our %cache;
18d2cc90
IJ
11 my $fc=$cache{$key};
12 return $fc if $fc;
13 foreach my $path (@rulespath) {
14 my $script="$path/$key.rules";
15 $!=0; $@=''; my $f = do $script;
16 if (defined $f) {
17 $cache{$key}=$f;
18 return $f;
19 }
20 die "$! $? $script" unless $! == &ENOENT;
21 }
22 return $cache{$key}=undef;
23}
24
25sub processbdf ($$) {
26 my ($inbdf,$outbdf) = @_;
4ee8efe0
IJ
27 my $state='idle';
28 my ($donefoundry,$donefont);
29 my ($w,$h,$xo,$yo,$y,$bitmap,$glyph);
18d2cc90
IJ
30 while (<$inbdf>) {
31 if ($state eq 'bitmap' && $y==$h) {
4ee8efe0
IJ
32 local ($_) = uc $glyph;
33 my $key= sprintf "%d,%d,%d,%d", $w,$h,$xo,$yo;
34 my $rules= loadrules($key);
18d2cc90
IJ
35 return 0 if !$rules;
36 s/\;$//;
37 $rules->();
38 print $outbdf $_,"\n" or die $!
4ee8efe0 39 foreach split /\;/, $_; # /;
18d2cc90
IJ
40 $state='idle';
41 }
42 if ($state eq 'bitmap') {
43 m/^([0-9a-fA-F]+)\s+$/ or die $y;
44 length($1) == (($w+7 >> 3) << 1) or die "$1 $w";
45 $glyph .= "$1;";
4ee8efe0
IJ
46 $y++;
47 next;
18d2cc90 48 }
4ee8efe0
IJ
49 if ($state eq 'idle' && m/^FOUNDRY\s+/) {
50 return 0 unless m/^FOUNDRY\s+\"[Mm]isc\"\s+/;
18d2cc90 51 s/misc/Trad/i;
4ee8efe0
IJ
52 $donefoundry=1;
53 }
54 if ($state eq 'idle' && m/^FONT\s+/) {
55 return 0 unless s/^(FONT\s+)\-[Mm]isc\-/$1-Trad-/;
56 $donefont=1;
18d2cc90
IJ
57 }
58 if ($state eq 'idle' && m/^STARTCHAR\s/) {
4ee8efe0
IJ
59 die unless $donefoundry;
60 die unless $donefont;
18d2cc90
IJ
61 $state='startchar';
62 $w=undef;
63 }
64 if ($state eq 'startchar') {
65 if (m/^BBX\s+(\+?\d+)\s+(\+?\d+)\s+([-+]?\d+)\s+([-+]?\d+)\s+$/) {
66 ($w,$h,$xo,$yo) = ($1,$2,$3,$4);
67 }
68 if (m/^BITMAP\s+$/) {
69 die unless defined $w;
70 $y=0;
71 $glyph='';
72 $state='bitmap';
73 }
74 }
4ee8efe0 75 print $outbdf $_ or die $!;
18d2cc90
IJ
76 }
77 die $! if $inbdf->error;
4ee8efe0 78 die $! if $outbdf->error or !$outbdf->flush;
18d2cc90
IJ
79 die unless $state eq 'idle';
80}
81
4ee8efe0
IJ
82processbdf((new IO::File '<&STDIN'),
83 (new IO::File '>&STDOUT'));
84
5f15b814
IJ
85
86# 70 zcat /usr/share/fonts/X11/misc/6x13.pcf.gz |pcf2bdf >in.bdf
87# 71 ./utility <in.bdf >out.bdf
88# 83 bdftopcf out.bdf >out.pcf
89# 84 gzip out.pcf
90# 85 cp out.pcf.gz /usr/share/fonts/X11/misc/
91# really mkfontdir /usr/share/fonts/X11/misc/
92# xset fp rehash
93# xfontsel