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 sub loadrules ($) {
   9     my ($key) = @_;
  10     our %cache;
  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) = @_;
  27     my $state='idle';
  28     my ($donefoundry,$donefont);
  29     my ($w,$h,$xo,$yo,$y,$bitmap,$glyph);
  30     while (<$inbdf>) {
  31         if ($state eq 'bitmap' && $y==$h) {
  32             local ($_) = uc $glyph;
  33             my $key= sprintf "%d,%d,%d,%d", $w,$h,$xo,$yo;
  34             my $rules= loadrules($key);
  35             return 0 if !$rules;
  36             s/\;$//;
  37             $rules->();
  38             print $outbdf $_,"\n" or die $!
  39                 foreach split /\;/, $_; # /;
  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;";
  46             $y++;
  47             next;
  48         }
  49         if ($state eq 'idle' && m/^FOUNDRY\s+/) {
  50             return 0 unless m/^FOUNDRY\s+\"[Mm]isc\"\s+/;
  51             s/misc/Trad/i;
  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;
  57         }
  58         if ($state eq 'idle' && m/^STARTCHAR\s/) {
  59             die unless $donefoundry;
  60             die unless $donefont;
  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         }
  75         print $outbdf $_ or die $!;
  76     }
  77     die $! if $inbdf->error;
  78     die $! if $outbdf->error or !$outbdf->flush;
  79     die unless $state eq 'idle';
  80 }
  81
  82 processbdf((new IO::File '<&STDIN'),
  83            (new IO::File '>&STDOUT'));
  84
  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