Commit | Line | Data |
---|---|---|
18d2cc90 IJ |
1 | #!/usr/bin/perl -w |
2 | use strict; | |
3 | use POSIX; | |
4 | use IO::File; | |
a2d36db5 | 5 | use Getopt::Long; |
18d2cc90 | 6 | |
a2d36db5 IJ |
7 | our $package='xfonts-traditional'; |
8 | our $sharedir="/usr/share/$package"; | |
9 | our @rulespath; | |
10 | our $mode; | |
18d2cc90 | 11 | |
4ee8efe0 IJ |
12 | sub loadrules ($) { |
13 | my ($key) = @_; | |
18d2cc90 | 14 | our %cache; |
18d2cc90 IJ |
15 | my $fc=$cache{$key}; |
16 | return $fc if $fc; | |
17 | foreach my $path (@rulespath) { | |
18 | my $script="$path/$key.rules"; | |
19 | $!=0; $@=''; my $f = do $script; | |
20 | if (defined $f) { | |
21 | $cache{$key}=$f; | |
22 | return $f; | |
23 | } | |
24 | die "$! $? $script" unless $! == &ENOENT; | |
25 | } | |
26 | return $cache{$key}=undef; | |
27 | } | |
28 | ||
29 | sub processbdf ($$) { | |
30 | my ($inbdf,$outbdf) = @_; | |
4ee8efe0 IJ |
31 | my $state='idle'; |
32 | my ($donefoundry,$donefont); | |
33 | my ($w,$h,$xo,$yo,$y,$bitmap,$glyph); | |
18d2cc90 IJ |
34 | while (<$inbdf>) { |
35 | if ($state eq 'bitmap' && $y==$h) { | |
4ee8efe0 IJ |
36 | local ($_) = uc $glyph; |
37 | my $key= sprintf "%d,%d,%d,%d", $w,$h,$xo,$yo; | |
38 | my $rules= loadrules($key); | |
18d2cc90 IJ |
39 | return 0 if !$rules; |
40 | s/\;$//; | |
41 | $rules->(); | |
42 | print $outbdf $_,"\n" or die $! | |
4ee8efe0 | 43 | foreach split /\;/, $_; # /; |
18d2cc90 IJ |
44 | $state='idle'; |
45 | } | |
46 | if ($state eq 'bitmap') { | |
47 | m/^([0-9a-fA-F]+)\s+$/ or die $y; | |
48 | length($1) == (($w+7 >> 3) << 1) or die "$1 $w"; | |
49 | $glyph .= "$1;"; | |
4ee8efe0 IJ |
50 | $y++; |
51 | next; | |
18d2cc90 | 52 | } |
4ee8efe0 IJ |
53 | if ($state eq 'idle' && m/^FOUNDRY\s+/) { |
54 | return 0 unless m/^FOUNDRY\s+\"[Mm]isc\"\s+/; | |
18d2cc90 | 55 | s/misc/Trad/i; |
4ee8efe0 IJ |
56 | $donefoundry=1; |
57 | } | |
58 | if ($state eq 'idle' && m/^FONT\s+/) { | |
59 | return 0 unless s/^(FONT\s+)\-[Mm]isc\-/$1-Trad-/; | |
60 | $donefont=1; | |
18d2cc90 IJ |
61 | } |
62 | if ($state eq 'idle' && m/^STARTCHAR\s/) { | |
4ee8efe0 IJ |
63 | die unless $donefoundry; |
64 | die unless $donefont; | |
18d2cc90 IJ |
65 | $state='startchar'; |
66 | $w=undef; | |
67 | } | |
68 | if ($state eq 'startchar') { | |
69 | if (m/^BBX\s+(\+?\d+)\s+(\+?\d+)\s+([-+]?\d+)\s+([-+]?\d+)\s+$/) { | |
70 | ($w,$h,$xo,$yo) = ($1,$2,$3,$4); | |
71 | } | |
72 | if (m/^BITMAP\s+$/) { | |
73 | die unless defined $w; | |
74 | $y=0; | |
75 | $glyph=''; | |
76 | $state='bitmap'; | |
77 | } | |
78 | } | |
4ee8efe0 | 79 | print $outbdf $_ or die $!; |
18d2cc90 IJ |
80 | } |
81 | die $! if $inbdf->error; | |
4ee8efe0 | 82 | die $! if $outbdf->error or !$outbdf->flush; |
18d2cc90 IJ |
83 | die unless $state eq 'idle'; |
84 | } | |
85 | ||
a2d36db5 IJ |
86 | our (@options)=( |
87 | 'R|rules-include=s@' => \@rulespath, | |
88 | 'share-dir=s' => \$sharedir, | |
89 | ); | |
4ee8efe0 | 90 | |
a2d36db5 IJ |
91 | sub define_mode ($$) { |
92 | my ($optname,$f) = @_; | |
93 | push @options, $optname, sub { | |
94 | die "only one mode may be specified\n" if defined $mode; | |
95 | $mode=$f; | |
96 | }; | |
97 | } | |
98 | ||
99 | define_mode('bdf-filter', sub { | |
100 | die if @ARGV; | |
101 | ||
102 | processbdf((new IO::File '<&STDIN'), | |
103 | (new IO::File '>&STDOUT')); | |
104 | }); | |
105 | ||
106 | Getopt::Long::Configure(qw(bundling)); | |
107 | GetOptions(@options) or exit 127; | |
108 | ||
109 | push @rulespath, "$sharedir/rules" unless @rulespath; | |
110 | ||
111 | die "need a mode\n" unless $mode; | |
112 | ||
113 | $mode->(); | |
5f15b814 IJ |
114 | |
115 | # 70 zcat /usr/share/fonts/X11/misc/6x13.pcf.gz |pcf2bdf >in.bdf | |
116 | # 71 ./utility <in.bdf >out.bdf | |
117 | # 83 bdftopcf out.bdf >out.pcf | |
118 | # 84 gzip out.pcf | |
119 | # 85 cp out.pcf.gz /usr/share/fonts/X11/misc/ | |
120 | # really mkfontdir /usr/share/fonts/X11/misc/ | |
121 | # xset fp rehash | |
122 | # xfontsel |