wip

[xfonts-traditional] / utility

#!/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');