#!/usr/bin/perl -w use strict; use POSIX; use IO::File; our @rulespath=('.'); our $state='begin'; our ($w,$h,$xo,$yo,$y,$bitmap,$glyph); sub loadrules () { our %cache; my $key= sprintf "%d,%d,%d,%d", $w,$h,$xo,$yo; my $fc=$cache{$key}; return $fc if $fc; foreach my $path (@rulespath) { my $script="$path/$key.rules"; $!=0; $@=''; my $f = do $script; if (defined $f) { $cache{$key}=$f; return $f; } die "$! $? $script" unless $! == &ENOENT; } return $cache{$key}=undef; } sub processbdf ($$) { my ($inbdf,$outbdf) = @_; while (<$inbdf>) { if ($state eq 'bitmap' && $y==$h) { local ($_) = lc $glyph; my $rules= loadrules(); return 0 if !$rules; s/\;$//; $rules->(); print $outbdf $_,"\n" or die $! foreach split /\;/ $_; # /; $state='idle'; } if ($state eq 'bitmap') { m/^([0-9a-fA-F]+)\s+$/ or die $y; length($1) == (($w+7 >> 3) << 1) or die "$1 $w"; $glyph .= "$1;"; } if ($state eq 'begin' && m/^FOUNDRY\s+/) { return 0 unless m/^FOUNDRY\s+\"[Mm]isc\"\s+/) { s/misc/Trad/i; $state='idle'; } if ($state eq 'idle' && m/^STARTCHAR\s/) { $state='startchar'; $w=undef; } if ($state eq 'startchar') { if (m/^BBX\s+(\+?\d+)\s+(\+?\d+)\s+([-+]?\d+)\s+([-+]?\d+)\s+$/) { ($w,$h,$xo,$yo) = ($1,$2,$3,$4); } if (m/^BITMAP\s+$/) { die unless defined $w; $y=0; $glyph=''; $state='bitmap'; } } } die $! if $inbdf->error; die $! if $outbdf->error or $outbdf->flush; die unless $state eq 'idle'; } processbdf('STDIN','STDOUT');