Commit | Line | Data |
---|---|---|
18d2cc90 IJ |
1 | #!/usr/bin/perl -w |
2 | use strict; | |
3 | use POSIX; | |
4 | use IO::File; | |
5 | ||
6 | our @rulespath=('.'); | |
7 | ||
4ee8efe0 IJ |
8 | sub 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 | ||
25 | sub 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 |
82 | processbdf((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 |