view ascii2bdf.pl @ 6:4ed010b4a017

batsu
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 26 Dec 2013 09:01:31 +0900
parents 0285a01caf93
children 4dcb674f0e0a
line wrap: on
line source

#!/usr/bin/perl
use strict;

my ($name,$encoding,@bitmap);

my ($lineno,$line);
my $width;
my $height;
my @header;
my $char;
my @bytes;
my %chars;

while(<>) {
    if(/^STARTFONT\s+(.*)/) {   
        push(@header,$_);
        while(<>) {
            push(@header,$_);
            last if(/^ENDPROPERTIES/);
        }
    } elsif(/^CHARS/) { 
    } elsif(/^STARTCHAR\s+(.*)/) { &init(); $name=$1; 
    } elsif (/^ENCODING\s+(\d+)/) {    $encoding=$1; $char={name=>$name,encoding=>$_}; $chars{$encoding} = $char;
    } elsif (/^SWIDTH (\d+) (\d+)/) { $char->{swidth} = $_;
    } elsif (/^DWIDTH (\d+) (\d+)/) { $width = $1; $char->{dwidth} = $_;
    } elsif (/^BBX ([-+\d]+) ([-+\d]+) ([-+\d]+) ([-+\d]+)/) { $height = $2; $char->{bbx} = $_;
    } elsif (/^BITMAP/) { $line = $lineno+2; # error line must start 1
    } elsif (/^ENDCHAR/) {  
        &display() if (@bitmap) ; 
    } elsif (/^[0-9A-Fa-f]+$/) {  push(@{$char->{byte}},$_);
    } elsif (/^[ *]*$/) {  chop; push(@bitmap,$_);
    }
    $lineno++;
    $lineno = 0 if (eof);
}

print @header if (@header);
print "CHARS ",scalar(keys %chars),"\n\n";
for my $k ( sort {$a <=> $b} keys %chars) {
    my $ch = $chars{$k};
    print "STARTCHAR $ch->{name}\n";
    print $ch->{encoding};
    print $ch->{swidth};
    print $ch->{dwidth};
    print $ch->{bbx};
    print "BITMAP\n";
    for my $byte (@{$ch->{byte}}) {
        print $byte;
    }
    print "ENDCHAR\n\n";
}
print "ENDFONT\n";

sub showchar {
    my ($ch) = @_;
    for my $k ( keys %{$ch} ) {
        print "$k => $ch->{$k}\n";
    }
}

sub display {
    my $hwidth = int((($width+7)&(~7))/4);
# print "hwdith $hwidth\n";
    my $i = 0;
    for my $hex (@bitmap) {
        my $bin;
        my $orig = $hex;
        my $j = 0;
        while($hex =~ s/..//) {
            if ($& eq "  ") {
                $bin .= "0";
            } elsif ($& eq "**") {
                $bin .= "1";
            } else {
                print STDERR $line+$i,": Error Bad Alignment ","| "x$width,"\n";
                print STDERR $line+$i,": Error Bad Alignment ","$orig\n";
                last;
            }
            if ($j++ > $width) {
                print STDERR $line+$i,": Error Too long",substr($orig,$j),
                        "|$hex too long \n" if ($hex =~ /[^ ]/);
                last;
            }
        }
# print "bitmap $bin -- $i\n";
        my $h =  pack("B*",$bin . "0"x$width);
        my $b = unpack("H*",$h);
        $b = substr($b,0,$hwidth);
        push(@{$char->{byte}},$b."\n");
        last if ($i++ > $height-2);
    }
    # print "hhhh $height-$i = ",$height-$i,"\n";
    # print (("0"x$hwidth."\n")x($height-$i)) if ($height-$i > 0);
    while ($height-$i > 0) {
        push(@{$char->{byte}},("0"x$hwidth."\n"));
        $i++;
    }
}

sub init {
    $name = '';
    $encoding = 0;
    @bitmap= ();
    @bytes= ();
}

=head1 NAME

ascii2bdf -- convert readable bdf to bdf and merge

=head1 AUTHORS

Shinji KONO <kono@ie.u-ryukyu.ac.jp>

=head1 SYNOPSIS

    perl ascii2bdf.pl orignal.bdf fix.bdf fix1.bdf

=head1 DESCRIPTION

this script converts

    STARTCHAR uni2163
    ENCODING 8547
    SWIDTH 960 0
    DWIDTH 14 0
    BBX 14 14 0 -2
    BITMAP

        **  **          **            
        **  **          **            
        **  **          **            
        **    **      **              
        **    **      **              
        **    **      **              
        **      **  **                
        **      **  **                
        **      **  **                
        **        **          
        **        **          
                                  
                                    
    ENDCHAR

to bdf and merge it to the orignal one.

=cut


# end