X-Git-Url: https://git.distorted.org.uk/~mdw/xfonts-traditional/blobdiff_plain/15fc3ba19faec7f483788f208af4df66579104f9..1b17f3ec12711c9c005fabc01735eeb399a07305:/utility diff --git a/utility b/utility deleted file mode 100755 index f03b771..0000000 --- a/utility +++ /dev/null @@ -1,181 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use POSIX; -use IO::File; -use Getopt::Long; - -our $package='xfonts-traditional'; -our $sharedir="/usr/share/$package"; -our @rulespath; -our $mode; -our %foundrymap; -our $verbose=0; -our $reportfh; - -sub reportloaded { - return unless $verbose; - print $reportfh @_,"\n" or die $!; -} - -sub loadrules ($) { - my ($key) = @_; - our %cache; - 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) { - reportloaded("rules: loaded ",$script); - $cache{$key}=$f; - return $f; - } - die "$! $? $script" unless $! == &ENOENT; - } - return $cache{$key}=undef; -} - -sub processbdf ($$$) { - my ($inbdf,$outbdf,$what) = @_; - my $state='idle'; - my ($foundry,$font); - my ($w,$h,$xo,$yo,$y,$bitmap,$glyph); - my $modified=0; - while (<$inbdf>) { - if ($state eq 'bitmap' && $y==$h) { - $glyph = uc $glyph; - $glyph =~ s/\;$//; - local ($_) = $glyph; - my $key= sprintf "%s,%d,%d,%d,%d", $foundry,$w,$h,$xo,$yo; - my $rules= loadrules($key); - return (0,'no rules') if !$rules; - $rules->(); - $modified += ($_ ne $glyph); - 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;"; - $y++; - next; - } - if ($state eq 'idle' && m/^FOUNDRY\s+/) { - die if defined $foundry; - return (0,'foundry syntax') unless m/^FOUNDRY\s+\"(\w+)\"\s+/; - $foundry = $foundrymap{lc $1}; - return (0,'no foundry') unless defined $foundry; - $_ = "FOUNDRY \"$foundry\"\n"; - } - if ($state eq 'idle' && m/^FONT\s+/) { - die if defined $font; - return 0 unless m/^(FONT\s+)\-(\w+)\-/; - $font = $foundrymap{lc $2}; - return (0,'no foundry') unless defined $font; - $_ = "FONT -$font-$'"; - } - if ($state eq 'idle' && m/^STARTCHAR\s/) { - die unless defined $foundry; - die unless defined $font; - return (0,'foundry != font') unless $foundry eq $font; - $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'; - } - } - print $outbdf $_ or die $!; - } - die $! if $inbdf->error; - die $! if $outbdf->error or !$outbdf->flush; - die unless $state eq 'idle'; - if ($modified) { - printf $reportfh "%s: %d glyphs changed\n", $what, $modified - or die $!; - } else { - printf $reportfh "%s: unchanged - no rules matched\n", $what - or die $!; - } - return $modified; -} - -our (@options)=( - 'R|rules-include=s@' => \@rulespath, - 'share-dir=s' => \$sharedir, - 'verbose|v+' => \$verbose, - ); - -sub define_mode ($$) { - my ($optname,$f) = @_; - push @options, $optname, sub { - die "only one mode may be specified\n" if defined $mode; - $mode=$f; - }; -} - -sub loadfoundries () { - foreach my $path (@rulespath) { - my $p = "$path/foundries"; - my $f = new IO::File $p; - if (!$f) { - die "$p $!" unless $!==&ENOENT; - print $reportfh "foundries: none in $p\n" or die $! if $verbose; - next; - } - while (<$f>) { - s/^\s*//; s/\s+$//; - next if m/^\#/; - m/^(\w+)\s+(\w+)$/ or die; - my $k = lc $1; - next if exists $foundrymap{$k}; - $foundrymap{$k}=$2; - } - $f->error and die $!; - reportloaded('foundries: loaded ',$p); - } - die "no foundry maps\n" unless %foundrymap; -} - -our $stdin = new IO::File '<&STDIN' or die $!; -our $stdout = new IO::File '>&STDOUT' or die $!; -our $stderr = new IO::File '>&STDERR' or die $!; -$reportfh = $stdout; - -define_mode('bdf-filter', sub { - die "no arguments allowed with --bdf-filter\n" if @ARGV; - $reportfh = $stderr; - loadfoundries(); - my $r = processbdf($stdin,$stdout,'stdin'); - if ($r !~ m/^\d/) { - print STDERR "stdin not processed: $r\n"; - exit 2; - } -}); - -Getopt::Long::Configure(qw(bundling)); -GetOptions(@options) or exit 127; - -push @rulespath, "$sharedir/rules"; - -die "need a mode\n" unless $mode; - -$mode->(); - -# 70 zcat /usr/share/fonts/X11/misc/6x13.pcf.gz |pcf2bdf >in.bdf -# 71 ./utility out.bdf -# 83 bdftopcf out.bdf >out.pcf -# 84 gzip out.pcf -# 85 cp out.pcf.gz /usr/share/fonts/X11/misc/ -# really mkfontdir /usr/share/fonts/X11/misc/ -# xset fp rehash -# xfontsel