File mkbold of Package baekmuk-bitmap-fonts

#!/usr/bin/perl
#
#  -- makes BDF font bold
#	programmed by NAGAO, Sadakazu <snagao@cs.titech.ac.jp>	
#	modified by Yasuyuki Furukawa <yasu@on.cs.keio.ac.jp>	
#		* public domain *
#

$bdir = 1;			# left
$pile = 0;			# right

$verbose = 0;
$verbose_min = 100;

for $opt (@ARGV) {
    if ($opt =~ /^-/) {	# option
	$bdir = 0 if $opt eq '-r';	# right
	$bdir = 1 if $opt eq '-l';	# left
	$pile = 0 if $opt eq '-R';	# right
	$pile = 1 if $opt eq '-L';	# left
	$verbose = 1 if $opt eq '-V';	# verbose
	next;
    } else {
	$file = $opt;
	last;
    }
}
$file= "-" unless $file;

open F, $file || die;

$col = int(`stty  -F /dev/tty size 2>/dev/null | sed 's/.* //'`) || 80;

$ch_count = 0;

@vmeter = ("|", "\\", "-", "/");

while (<F>) {

    if (/^FONT[ \t]/ || /^WEIGHT_NAME/) {
	s/Medium/Bold/i;
	print;
	next;
    }

    if (/^CHARS[ \t]/) {
	$max_chars = substr($_, 6);
    }

    if (/^BITMAP/) {
	$bitmap = 1;
	print;
	next;
    }

    if (/^ENDCHAR/) {
	$bitmap = 0;
	print;

	if (($ch_count++ % 20) == 0 && $verbose != 0 && $max_chars > $verbose_min) {
	    $n = int($ch_count * 100 / $max_chars);
	    $m = int($n * ($col - 21) / 100);
	    $l = $col - 20 - $m;
	    printf STDERR "\rprogress|" . rstr("=", $m) . rstr(" ", $l) . "$n%%" . $vmeter[$ch_count2++ % 4] 
	}
	next;
    }

    if ($bitmap) {
	chop;
	$l = (length($_) / 2) - 1;

	if ($bdir) {		# left
	    for $i (0..$l) {
		$d[$i] = hex(substr($_, $i*2, 2));
	    }
	    shl(\@bold, \@d, $l);
	} else {
	    for $i (0..$l) {	# right
		$bold[$i] = hex(substr($_, $i*2, 2));
	    }
	    shr(\@d, \@bold, $l);

	}

	if ($pile) {		# left
	    shl(\@tmp, \@bold, $l);
	    bitcalc(\@d, \@tmp, \@d, \@bold, $l);
	} else {		# right
	    shr(\@tmp, \@d, $l);
	    bitcalc(\@d, \@tmp, \@bold, \@d, $l);
	}

	# print
	for $i (0..$l) {
	    printf "%02x", $d[$i];
	}

	print "\n";
	next;
    }

    print;

}
close F;

if ($verbose != 0 && $max_chars > $verbose_min) {
    printf STDERR "\r" . rstr(" ", $col - 3) . "\r";
}

exit 0;

sub shl {
    my ($dout, $din, $size) = @_;
    my $c = 0, $d, $i;
    for ($i = $size; $i >= 0; $i--) {
	$d = $c;
	$c = ($din->[$i] & 0x80) >> 7;
	$dout->[$i] = (($din->[$i] << 1) & 0xff) | $d;
    }
}

sub shr {
    my ($dout, $din, $size) = @_;
    my $c = 0, $d, $i;
    for $i (0..$size) {
	$d = $c;
	$c = ($din->[$i] & 0x01) << 7;
	$dout->[$i] = ($din->[$i] >> 1) | $d;
    }
}

sub bitcalc {
    my ($out, $d1, $d2, $d3, $size) = @_;
    for $i (0..$size) {
	$out->[$i] = ~$d1->[$i] & $d2->[$i] | $d3->[$i];
    }
}

sub rstr # (s, n)
{
    my($s, $n) =  @_;
    my $r = "";

    for (1 .. $n) {
	$r = $s . $r;
    }
    return $r;
}