1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
|
use warnings;
use strict;
use FindBin;
use lib $FindBin::Bin;
use File::Path qw(make_path);
use icn;
my @FontHeaderVars = qw(
max_width
max_height
std_height
first_char
last_char
);
my $FontHeaderPacking = 'SSSSS';
my $FontHeaderSize = 10;
my @FontInfoVars = qw(
offset_y
width
height
bitmap_offset
);
my $FontInfoPacking = 'cCCL';
my $FontInfoSize = 7;
if (!@ARGV) {
print "Usage: $0 FNT.RES outdir\n";
print "Dump information from FNT.RES and optionally write data to outdir.\n";
exit 0;
}
my ($font_file, $outdir) = @ARGV;
my $dumping_font = 0;
if (defined($outdir)) {
eval { make_path($outdir) };
if ($@) {
print "Error: Cannot create $outdir\n";
exit 1;
}
$dumping_font = 1;
}
my $font_fh;
if (!open($font_fh, '<', $font_file)) {
print "Error: Unable to open $font_file\n";
exit 1;
}
my $buf;
my @elements;
read($font_fh, $buf, $FontHeaderSize);
@elements = unpack($FontHeaderPacking, $buf);
my %header = map { $FontHeaderVars[$_] => $elements[$_] } 0..$#FontHeaderVars;
print "font header: max_width=$header{max_width} max_height=$header{max_height} std_height=$header{std_height} first_char=$header{first_char} last_char=$header{last_char}\n";
if ($dumping_font) {
write_file(\%header, File::Spec->catfile($outdir, "header.txt"));
}
my @info;
for (my $i = $header{first_char}; $i <= $header{last_char}; $i++) {
read($font_fh, $buf, $FontInfoSize);
@elements = unpack($FontInfoPacking, $buf);
my %font_info = map { $FontInfoVars[$_] => $elements[$_] } 0..$#FontInfoVars;
push(@info, \%font_info);
print "font info $i: offset_y=$font_info{offset_y} width=$font_info{width} height=$font_info{height} bitmap_offset=$font_info{bitmap_offset}\n";
if ($dumping_font) {
write_file(\%font_info, File::Spec->catfile($outdir, "$i.txt"));
}
}
for (my $i = $header{first_char}; $i <= $header{last_char}; $i++) {
if (eof($font_fh)) {
print "bad end of file\n";
exit 1;
}
my $icn = icn->read_file($font_fh);
print "char $i bmp of h=", $icn->height(), " w=", $icn->width(), "\n";
$icn->print_ascii(*STDOUT);
if ($dumping_font) {
my $outfile = File::Spec->catfile($outdir, "$i.ICN");
my $out_fh;
if (!open($out_fh, '>', $outfile)) {
print "Error: Cannot open $outfile\n";
exit 1;
}
$icn->write_file($out_fh);
close($out_fh);
}
}
close($font_fh);
exit 0;
sub write_file {
my $h;
my $filename;
($h, $filename) = @_;
my $fh;
if (!open($fh, '>', $filename)) {
print "Error: Cannot open $filename\n";
exit 1;
}
print $fh map {"$_=$h->{$_}\n"} keys(%$h);
close($fh);
}
|