chiark - git - mdw - xfonts-traditional/blob - utility

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use POSIX;
   4 use IO::File;
   5
   6 our @rulespath=('.');
   7
   8 our $state='begin';
   9 our ($w,$h,$xo,$yo,$y,$bitmap,$glyph);
  10
  11 sub loadrules () {
  12     our %cache;
  13     my $key= sprintf "%d,%d,%d,%d", $w,$h,$xo,$yo;
  14     my $fc=$cache{$key};
  15     return $fc if $fc;
  16     foreach my $path (@rulespath) {
  17         my $script="$path/$key.rules";
  18         $!=0; $@=''; my $f = do $script;
  19         if (defined $f) {
  20             $cache{$key}=$f;
  21             return $f;
  22         }
  23         die "$! $? $script" unless $! == &ENOENT;
  24     }
  25     return $cache{$key}=undef;
  26 }
  27
  28 sub processbdf ($$) {
  29     my ($inbdf,$outbdf) = @_;
  30     while (<$inbdf>) {
  31         if ($state eq 'bitmap' && $y==$h) {
  32             local ($_) = lc $glyph;
  33             my $rules= loadrules();
  34             return 0 if !$rules;
  35             s/\;$//;
  36             $rules->();
  37             print $outbdf $_,"\n" or die $!
  38                 foreach split /\;/ $_; # /;
  39             $state='idle';
  40         }
  41         if ($state eq 'bitmap') {
  42             m/^([0-9a-fA-F]+)\s+$/ or die $y;
  43             length($1) == (($w+7 >> 3) << 1) or die "$1 $w";
  44             $glyph .= "$1;";
  45         }
  46         if ($state eq 'begin' && m/^FOUNDRY\s+/) {
  47             return 0 unless m/^FOUNDRY\s+\"[Mm]isc\"\s+/) {
  48             s/misc/Trad/i;
  49             $state='idle';
  50         }
  51         if ($state eq 'idle' && m/^STARTCHAR\s/) {
  52             $state='startchar';
  53             $w=undef;
  54         }
  55         if ($state eq 'startchar') {
  56             if (m/^BBX\s+(\+?\d+)\s+(\+?\d+)\s+([-+]?\d+)\s+([-+]?\d+)\s+$/) {
  57                 ($w,$h,$xo,$yo) = ($1,$2,$3,$4);
  58             }
  59             if (m/^BITMAP\s+$/) {
  60                 die unless defined $w;
  61                 $y=0;
  62                 $glyph='';
  63                 $state='bitmap';
  64             }
  65         }
  66     }
  67     die $! if $inbdf->error;
  68     die $! if $outbdf->error or $outbdf->flush;
  69     die unless $state eq 'idle';
  70 }
  71
  72 processbdf('STDIN','STDOUT');