wip

[xfonts-traditional.git] / utility

diff --git a/utility b/utility
new file mode 100755 (executable)
index 0000000..41c9455
--- /dev/null
+++ b/utility
@@ -0,0 +1,72 @@
+#!/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');