0
|
1 #!/usr/bin/perl
|
|
2 use strict;
|
|
3
|
|
4 my ($name,$encoding,@bitmap);
|
|
5
|
|
6 my ($lineno,$line);
|
|
7 my $width;
|
|
8 my $height;
|
2
|
9 my @header;
|
|
10 my $char;
|
|
11 my @bytes;
|
|
12 my %chars;
|
0
|
13
|
|
14 while(<>) {
|
2
|
15 if(/^STARTFONT\s+(.*)/) {
|
|
16 push(@header,$_);
|
|
17 while(<>) {
|
|
18 push(@header,$_);
|
|
19 last if(/^ENDPROPERTIES/);
|
|
20 }
|
|
21 } elsif(/^CHARS/) {
|
|
22 } elsif(/^STARTCHAR\s+(.*)/) { &init(); $name=$1;
|
|
23 } elsif (/^ENCODING\s+(\d+)/) { $encoding=$1; $char={name=>$name,encoding=>$_}; $chars{$encoding} = $char;
|
|
24 } elsif (/^SWIDTH (\d+) (\d+)/) { $char->{swidth} = $_;
|
|
25 } elsif (/^DWIDTH (\d+) (\d+)/) { $width = $1; $char->{dwidth} = $_;
|
|
26 } elsif (/^BBX ([-+\d]+) ([-+\d]+) ([-+\d]+) ([-+\d]+)/) { $height = $2; $char->{bbx} = $_;
|
|
27 } elsif (/^BITMAP/) { $line = $lineno+2; # error line must start 1
|
|
28 } elsif (/^ENDCHAR/) {
|
|
29 &display() if (@bitmap) ;
|
|
30 } elsif (/^[0-9A-Fa-f]+$/) { push(@{$char->{byte}},$_);
|
6
|
31 } elsif (/^[ *]*$/) { chop; push(@bitmap,$_);
|
0
|
32 }
|
|
33 $lineno++;
|
2
|
34 $lineno = 0 if (eof);
|
|
35 }
|
|
36
|
|
37 print @header if (@header);
|
3
|
38 print "CHARS ",scalar(keys %chars),"\n\n";
|
2
|
39 for my $k ( sort {$a <=> $b} keys %chars) {
|
|
40 my $ch = $chars{$k};
|
|
41 print "STARTCHAR $ch->{name}\n";
|
|
42 print $ch->{encoding};
|
|
43 print $ch->{swidth};
|
|
44 print $ch->{dwidth};
|
|
45 print $ch->{bbx};
|
|
46 print "BITMAP\n";
|
|
47 for my $byte (@{$ch->{byte}}) {
|
|
48 print $byte;
|
|
49 }
|
|
50 print "ENDCHAR\n\n";
|
|
51 }
|
|
52 print "ENDFONT\n";
|
|
53
|
|
54 sub showchar {
|
|
55 my ($ch) = @_;
|
|
56 for my $k ( keys %{$ch} ) {
|
|
57 print "$k => $ch->{$k}\n";
|
|
58 }
|
0
|
59 }
|
|
60
|
|
61 sub display {
|
|
62 my $hwidth = int((($width+7)&(~7))/4);
|
|
63 # print "hwdith $hwidth\n";
|
|
64 my $i = 0;
|
|
65 for my $hex (@bitmap) {
|
|
66 my $bin;
|
|
67 my $orig = $hex;
|
|
68 my $j = 0;
|
|
69 while($hex =~ s/..//) {
|
|
70 if ($& eq " ") {
|
|
71 $bin .= "0";
|
|
72 } elsif ($& eq "**") {
|
|
73 $bin .= "1";
|
|
74 } else {
|
6
|
75 print STDERR $line+$i,": Error Bad Alignment ","| "x$width,"\n";
|
|
76 print STDERR $line+$i,": Error Bad Alignment ","$orig\n";
|
0
|
77 last;
|
|
78 }
|
|
79 if ($j++ > $width) {
|
6
|
80 print STDERR $line+$i,": Error Too long",substr($orig,$j),
|
0
|
81 "|$hex too long \n" if ($hex =~ /[^ ]/);
|
|
82 last;
|
|
83 }
|
|
84 }
|
|
85 # print "bitmap $bin -- $i\n";
|
|
86 my $h = pack("B*",$bin . "0"x$width);
|
|
87 my $b = unpack("H*",$h);
|
|
88 $b = substr($b,0,$hwidth);
|
2
|
89 push(@{$char->{byte}},$b."\n");
|
0
|
90 last if ($i++ > $height-2);
|
|
91 }
|
|
92 # print "hhhh $height-$i = ",$height-$i,"\n";
|
2
|
93 # print (("0"x$hwidth."\n")x($height-$i)) if ($height-$i > 0);
|
|
94 while ($height-$i > 0) {
|
|
95 push(@{$char->{byte}},("0"x$hwidth."\n"));
|
|
96 $i++;
|
|
97 }
|
0
|
98 }
|
|
99
|
|
100 sub init {
|
|
101 $name = '';
|
|
102 $encoding = 0;
|
|
103 @bitmap= ();
|
2
|
104 @bytes= ();
|
0
|
105 }
|
|
106
|
2
|
107 =head1 NAME
|
|
108
|
|
109 ascii2bdf -- convert readable bdf to bdf and merge
|
|
110
|
|
111 =head1 AUTHORS
|
|
112
|
|
113 Shinji KONO <kono@ie.u-ryukyu.ac.jp>
|
|
114
|
|
115 =head1 SYNOPSIS
|
|
116
|
|
117 perl ascii2bdf.pl orignal.bdf fix.bdf fix1.bdf
|
|
118
|
|
119 =head1 DESCRIPTION
|
|
120
|
|
121 this script converts
|
|
122
|
|
123 STARTCHAR uni2163
|
|
124 ENCODING 8547
|
|
125 SWIDTH 960 0
|
|
126 DWIDTH 14 0
|
|
127 BBX 14 14 0 -2
|
|
128 BITMAP
|
|
129
|
|
130 ** ** **
|
|
131 ** ** **
|
|
132 ** ** **
|
|
133 ** ** **
|
|
134 ** ** **
|
|
135 ** ** **
|
|
136 ** ** **
|
|
137 ** ** **
|
|
138 ** ** **
|
|
139 ** **
|
|
140 ** **
|
|
141
|
|
142
|
|
143 ENDCHAR
|
|
144
|
|
145 to bdf and merge it to the orignal one.
|
|
146
|
|
147 =cut
|
|
148
|
|
149
|
0
|
150 # end
|