#!/usr/bin/env perl

$version = '$Id: bdf2gdr.pl,v 3.8 2005/06/20 08:11:33 tsumura Exp $';

#    Copyright (c) 2005 TSUMURA,Tomoaki.
#    All rights reserved.
#
#    Redistribution and use in source and binary forms, with or without
#    modification, are permitted provided that the following conditions
#    are met:
#    1. Redistributions of source code must retain the above copyright
#       notice, this list of conditions and the following disclaimer.
#    2. Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#    3. Neither the name of TSUMURA Tomoaki nor the names of its contributors
#       may be used to endorse or promote products derived from this software
#       without specific prior written permission.
#
#    THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
#    ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#    IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#    ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
#    FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
#    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
#    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
#    OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
#    SUCH DAMAGE.

#
# This program is based on 
#
# - hex2bdf
#    (c) Copyright 2000-2001 /efont/ The Electronic Font Open Laboratory.
#
# - bdfmerge
#    by 1@2ch (public domain)

# My special thanks are due to
#        >>777 of Vodafone 702NK (Nokia6630) vol.28 thread
#    and >>104 of Vodafone 702NK (Nokia6630) vol.29 thread.
# for advising my work.


# code:
$| = 1;

use FileHandle;
require 5.005;

$TRUE  = 1;
$FALSE = 0;

$base			= $$;
$out{'bdf'}		= "${base}.bdf";
$out{'gd'}		= "${base}.gd";

$opt{'replace'}		= $FALSE;
$opt{'prop'}		= $FALSE;
$opt{'forceprop'}	= $FALSE;
$opt{'auto'}		= $FALSE;
$opt{'noascii'}		= $FALSE;
$opt{'jp_both'}		= $FALSE;
$opt{'docomo'}		= $FALSE;

if( $#ARGV < 0 ){
    usage();
}

@noprops = ('0020',       # ' '
#	    '002C', '002E', # , .
	    '2500', '2501', '2502', '2503', '250C', '250F', '2510', '2513', '2514', '2517', '2518', '251B', '251C', '251D', '2520', '2523', '2524', '2525', '2528', '252B', '252C', '252F', '2530', '2533', '2534', '2537', '2538', '253B', '253C', '253F', '2542', '254B',
	    '3000',       # '  '
	    '3001', '3002', # 、。
	    'FF0C', 'FF0E', # ，．
	    'FF61', 'FF64' # 、。(half)
	   );

while( $#ARGV > -1 ){
    my($arg) = shift( @ARGV );
    if( $arg =~ /^-(\S+)/ ){
	if( $1 eq 'p'){
	    $opt{'prop'}	= $TRUE;
	}elsif( $1 eq 'pp' ){
	    $opt{'prop'}	= $TRUE;
	    $opt{'forceprop'}	= $TRUE;
	}elsif( $1 eq 'P' ){
	    $opt{'prop'}	= $FALSE;
	    $opt{'forceprop'}	= $FALSE;
	}elsif( $1 eq 'a' ){
	    $opt{'auto'}	= $TRUE;
	}elsif( $1 eq 'n'){
	    $out{'fontid'}	= shift( @ARGV );
	}elsif( $1 eq '12' || $1 eq '16' ){
	    $opt{'replace'}	= $1 + 0;
	}elsif( $1 eq 'JP' ){
	    $opt{'jp_both'}	= $TRUE;
	}elsif( $1 eq 'd'){
	    $opt{'docomo'}	= $TRUE;
	}elsif( $1 eq 'h' ){
	    usage();
	}
    }else{
	push(@inbdfs, $arg);
    }
}

sub usage{
    print <<EoU;
Usage: 
 $0 [-16|-12|-JP] [-p|-pp] [-n name] [-a] jis.bdf rk.bdf ascii.bdf

\t-16     : generate JapanPlain16 compatible font (emoji available)
\t-12     : generate JapanPlain12 compatible font (emoji available)
\t-JP     : generate JapanPlain16/12 compatible font (with small emoji)
\t-n name : specify font name (default: MyFont)
\t-p      : reduce horizontal margins
\t-pp     : force all characters to reduce horizontal margins
\t-a      : call fnttran.exe and remove bdf/gd files automatically
\t-d      : include emoji for DoCoMo
EoU
    exit 0;
}

if( $opt{'jp_both'} ){
    $opt{'replace'} = 12;
}

if( $opt{'replace'} ){
    $out{'fontid'} = 'JapanPlain' . $opt{'replace'};
}elsif( ! defined($out{'fontid'}) ){
    $out{'fontid'} = 'MyFont';
}



print "-----------------------------------------------------------------\n";
print "[OPTION] Reduce Horizontal Margins (Proportional)       ... ";
print ($opt{'prop'} ? "ON\n" : "OFF\n") ;
print "[OPTION] Generate JapanPlain Compatible Font       ........ ";
print ($opt{'replace'} ? "YES\n" : "NO\n") ;

sub error{
    my($str) = $_[0];
    die "\n!!! Error !!!  $str\n\n";
}

sub bdfp{
    my($bdf) = $_[0];
    my($line, $reg, $enc, %prop);
    open(TMP, $bdf);
    $line = <TMP>;
    if( $line !~ /STARTFONT/i ){
	error("File `$bdf' is not a BDF!");
    }else{
	while( $line !~ /^ENDPROPERTIES/i ){
	    $line = <TMP>;
	    $line =~ s/\r\n//g;
	    chomp($line);
	    if( $line =~ /^PIXEL_SIZE (\d+)$/i ){
		$prop{'size'} = $1 + 0;
	    }elsif( $line =~ /^CHARSET_REGISTRY (\S+)$/i ){
		$prop{'reg'} = lc($1);
		$prop{'reg'} =~ s/"//g;
	    }elsif( $line =~ /^CHARSET_ENCODING (\S+)$/i ){
		$prop{'enc'} = $1;
		$prop{'enc'} =~ s/"//g;
	    }elsif( $line =~ /^FONTBOUNDINGBOX (\d+) (\d+) ([-0-9]+) ([-0-9]+)$/ ){
		$prop{'fbbx_w'} = $1 + 0;
		$prop{'fbbx_h'} = $2 + 0;
		$prop{'fbbx_x'} = $3 + 0;
		$prop{'fbbx_y'} = $4 + 0;
# 	    }elsif( $line =~ /^FONT_DESCENT (\d+)$/ ){
# 		$prop{'descent'} = $1 + 0;
# 	    }elsif( $line =~ /^FONT_ASCENT (\d+)$/ ){
# 		$prop{'ascent'} = $1 + 0;
	    }
	}
    }
    close(TMP);
    if( $prop{'reg'} =~ /^jisx0208/ && $prop{'enc'} eq '0' ){
	%jis = %prop;
	$jis{'bdf'} = $bdf;
    }elsif( $prop{'reg'} =~ /^jisx0201/ && $prop{'enc'} eq '0' ){
	%rk  = %prop;
	$rk{'bdf'} = $bdf;
    }elsif( $prop{'reg'} =~ /^iso8859/ && $prop{'enc'} eq '1' ){
	%asc = %prop;
	$asc{'bdf'} = $bdf;
    }elsif( $prop{'reg'} =~ /^iso10646/ && $prop{'enc'} eq '1' ){
	%uni = %prop;
	$uni{'bdf'} = $bdf;
    }else{
	error("BDF `$bdf' has invalid charset ($prop{'reg'}-$prop{'enc'}).");
    }
}

foreach( @inbdfs ){ bdfp( $_ ); }

#
# check
#
if( defined( $uni{'bdf'} ) ){
    %ltn = %asc;
    %asc = %uni;
}else{
    if( ! defined($jis{'bdf'}) ){ error( "JISX0208 bdf is not found" ); }
    if( ! defined($rk{'bdf'})  ){ error( "JISX0201 bdf is not found" ); }
    if( ! defined($asc{'bdf'}) ){
	open(TMP, $rk{'bdf'});
	while(<TMP>){
	    if( /^ENCODING ([a-fA-F0-9]+)$/i && $1 eq '41'){ # 0x41 = 'A'
		$opt{'noascii'} = 1; last;
	    }
	}
	close(TMP);
	if( !$opt{'noascii'} ){ error("ASCII (ISO8859-1) bdf is not found."); }
    }
}

#
# fbbx
#
sub max{
    my($a, $b, $c) = @_;
    my($m);
    $m = $a > $b ? $a : $b;
    $m = $m > $c ? $m : $c;
    return( $m );
}

sub min{
    my($a, $b, $c) = @_;
    my($m);
    $m = $a < $b ? $a : $b;
    $m = $m < $c ? $m : $c;
    return( $m );
}

%out;

if( $opt{'noascii'} ){
    %asc = %rk;
}

$out{'minsize'} = min( ($jis{'fbbx_h'} < 1 ? 100 : $jis{'fbbx_h'}),
		       ($rk{'fbbx_h'} < 1 ? 100 : $rk{'fbbx_h'}),
		       ($asc{'fbbx_h'} < 1 ? 100 : $asc{'fbbx_h'}) );
$out{'fbbx_x'} = min( $jis{'fbbx_x'}, $rk{'fbbx_x'}, $asc{'fbbx_x'} );
$out{'fbbx_y'} = 0;
$out{'fbbx_w'} = max( $jis{'fbbx_x'} + $jis{'fbbx_w'},
		      $rk{'fbbx_x'}  + $rk{'fbbx_w'},
		      $asc{'fbbx_x'} + $asc{'fbbx_w'} ) - $out{'fbbx_x'};

$jis{'voffset'} = ( $jis{'fbbx_y'} < 0 ) ? abs($jis{'fbbx_y'}) : 0 ;
$rk{'voffset'}  = ( $rk{'fbbx_y'}  < 0 ) ? abs($rk{'fbbx_y'})  : 0 ;
$asc{'voffset'} = ( $asc{'fbbx_y'} < 0 ) ? abs($asc{'fbbx_y'}) : 0 ;

$out{'fbbx_h'} = max( $jis{'fbbx_h'}, $rk{'fbbx_h'}, $asc{'fbbx_h'} );

# if( $out{'fbbx_h'} > $jis{'fbbx_h'} ){
#     $jis{'voffset'} += int( ($out{'fbbx_h'} - $jis{'fbbx_h'}) / 2 );
# }
# if( $out{'fbbx_h'} > $rk{'fbbx_h'} ){
#     $rk{'voffset'} +=  int( ($out{'fbbx_h'} - $rk{'fbbx_h'})  / 2 );
# }
# if( $out{'fbbx_h'} > $asc{'fbbx_h'} ){
#     $asc{'voffset'} += int( ($out{'fbbx_h'} - $asc{'fbbx_h'}) / 2 );
# }

#
# UID
#
sub genuid {
    my($r) = int( rand( 251658239 ) );
    return ( $r + 16777216 );
}
$out{'uid'} = genuid();

##################################################
# to Unicode BDF
##################################################
%glyph;

# emoji
if( $opt{'replace'} ){
    if( $opt{'docomo'} ){	# DoCoMo (for NM850iG?)
	$emoji_from = 0xE63E;
	$emoji_to   = 0xE757;
    }else{			# Vodafone
	$emoji_from = 0xE001;
	$emoji_to   = 0xE53E;
    }

    for( $i = $emoji_from; $i <= $emoji_to; $i++ ){
	$char1 = sprintf("STARTCHAR U+%X\nENCODING %d\n", $i, $i);
# 	$char1 .= "SWIDTH 960 0\nDWIDTH $out{'fbbx_w'} 0\n";
# 	$char1 .= "BBX $out{'fbbx_w'} $out{'fbbx_w'} $out{'fbbx_x'} $out{'fbbx_y'}\nBITMAP\n";
	$char1 .= "SWIDTH 960 0\nDWIDTH $opt{'replace'} 0\n";
	$char1 .= "BBX $opt{'replace'} $opt{'replace'} $out{'fbbx_x'} $out{'fbbx_y'}\nBITMAP\n";
#	for( 1..$out{'fbbx_w'} ){ # force square
	for( 1..$opt{'replace'} ){ # force square
	    $char1 .= "00\n";
	}
	$char1 .= "ENDCHAR\n";
	$glyph{ $i + 0 } = $char1;
   }
}

#
# reduce margins
#
sub reducep {
    my($enc) = $_[0];
    my(@r) = grep(/^${enc}$/, @noprops);
    if( $opt{'prop'} ){
	if( $opt{'forceprop'} ){
	    return $TRUE;
	}elsif( $#r == 0 ){
	    return $FALSE;
	}else{
	    return $TRUE;
	}
    }else{
	return $FALSE;
    }
}

sub reducemargin{
    my($bmp, $orgwidth) = @_;
    my($newbmp, $newbbxw);
    my(@line, @newline, $lmargin, $rmargin, $i, $tmp, $width, $bit, $tib);
    $bmp =~ s/^\n//;
    chomp($bmp);
    @line = split(/\n/, $bmp);
    $width = length($line[0]) * 4;
    $lmargin = $orgwidth;
    $rmargin = $orgwidth;
    foreach( @line ){
	chomp;
	$bit = substr( sprintf("%0${width}b", hex($_)), 0, $orgwidth );
	$tib = reverse($bit);
	# left
	if( $bit !~ /^0+$/ ){
	    $i = index( $bit, /[^0]/ );
	    if( $i < $lmargin ){ $lmargin = $i; }
	}
	# right
	if( $tib !~ /^0+$/ ){
	    $i = index( $tib, /[^0]/ );
	    if( $i < $rmargin ){ $rmargin = $i; }
	}
    }
    if( $lmargin < 0 || $orgwidth <= $lmargin ){ $lmargin = 0; }
    if( $rmargin < 0 || $orgwidth <= $rmargin ){ $rmargin = 0; }
    if( $lmargin || $rmargin ){
	$newbbxw = $orgwidth - $rmargin - $lmargin;
	foreach( @line ){
	    if( $_ ){
		$tmp = $_;
		push( @newline,
		      unpack("H*", pack("B*", 
					substr( sprintf("%0${width}b", hex($tmp)),
						$lmargin, $newbbxw))));
	    }
	}
	$newbmp = join("\n", @newline);
    }else{
	$newbmp = $bmp;
	$newbbxw = $orgwidth;
    }
    $newbmp =~ s/^\s*\n$//g;
    return( "\n$newbmp", $newbbxw );
}

#
# symbols
#
sub getglyph_hex {
    my($infile, $size, $glue) = @_;
    my(%c, $char, $enc, $bmp, $i, $hexwidth, $binwidth);
    my($bbxw);
    open(TMP, $infile);
    while(<TMP>){
	if( /([0-9A-Fa-f]{4,}):([0-9a-fA-F]+)\n/ ){
	    $enc = $1;
	    $bmp = $2;
	    $hexwidth = length($bmp) / $size / 2;
	    $binwidth = $hexwidth * 8;
 	    if( $glue ){
 		for( $i = 0; $i < $glue; $i++ ){ # pad empty line
 		    $bmp .= unpack("H*", pack("B*", sprintf("%0${binwidth}d", 0)));
 		}
 	    }
	    $bmp =~ s/((..){$hexwidth})/\n$1/g;
	    $bbxw = $binwidth;
	    if( reducep($enc) ){
		($bmp, $bbxw) = reducemargin( $bmp, $bbxw );
	    }
	    $char  = "STARTCHAR U+${enc}\n";
	    $char .= 'ENCODING ' . hex($enc) . "\n";
	    $char .= "SWIDTH 1000 0\n";
	    $char .= sprintf("DWIDTH %d 0\n", $bbxw + 1);
	    $char .= sprintf("BBX $bbxw %d 0 0\n", $size + $glue);

	    $char .= "BITMAP $bmp\n";
	    $char .= "ENDCHAR\n";
	    $glyph{ hex($enc) + 0 } = $char;
	}
    }
}

if( -r "SYMBOL$out{'minsize'}.HEX" ){
    printf "Symbol table is found. (SYMBOL%d.HEX)\n", 
	   $out{'minsize'};
    getglyph_hex("SYMBOL$out{'minsize'}.HEX", $out{'minsize'}, 0);
}elsif( -r sprintf("SYMBOL%d.HEX", $out{'minsize'} - 1) ){
    printf "Symbol table is found. (SYMBOL%d.HEX) lazy merge\n", 
           $out{'minsize'} - 1;
    getglyph_hex( sprintf("SYMBOL%d.HEX",$out{'minsize'}-1), $out{'minsize'}-1, 1 );
}else{
    printf "WARNING: Symbol table is NOT found (%d).\n", $out{'minsize'};
}

if( defined( $uni{'bdf'} ) ){
    print "Unicode font is found.  Latin font `$ltn{'bdf'}' is discarded.\n";
}

#
# chars
#
print "-----------------------------------------------------------------\n";

sub getglyph{
    my($bdf, $tbl, $hoffset, $voffset) = @_;
    my(%map) = ();
    my($char1, %char, $inchar, $inheader, $enc);
    my($chars, $count, $cbase, $pct, $line);
    printf "Reading %-24s ... |--------------------|", $bdf;
    print "\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b";
    if( $tbl ){
	open(MAP, $tbl) || error("Cannot find map file $tbl");
	while(<MAP>){
	    /^0x([a-fA-F0-9]+)\s+0x([a-fA-F0-9]+)/;
	    $map{ hex($1) } = hex($2);
	}
	close(MAP);
    }
    open(BDF, $bdf);
    $count = 0;
    $cbase = 0;
    $line = <BDF>;
    while( $line ){
 	if( $line =~ /^CHARS (\d+)/i ){
 	    $chars = $1 + 0;
 	}elsif( $line =~ /^STARTCHAR\s+(\S+)/i ){
	    %char = ();
	    $char{'name'} = $1;
	    $line = <BDF>;
	    while( $line !~ /^ENDCHAR/ ){
		if( $line =~ /^ENCODING\s+(\d+)/i ){
		    $char{'enc'} = $1 + 0;
 		    if( defined($map{$char{'enc'}}) ){
 			$char{'enc'} = $map{$char{'enc'}};
 		    }elsif( $tbl ){
			$char{'enc'} = 0;
		    }
		    $line = <BDF>;
		}elsif( $line =~ /^SWIDTH\s+(\d+)/i ){
		    $char{'swidth'} = $1;
		    $line = <BDF>;
		}elsif( $line =~ /^DWIDTH\s+(\d+)/i ){
		    $char{'dwidth'} = $1;
		    $line = <BDF>;
		}elsif( $line =~ /^BBX\s+(\d+)\s+(\d+)\s+([-0-9]+)\s+([-0-9]+)\b/i ){
		    $char{'bbx_w'} = $1 + 0;
		    $char{'bbx_h'} = $2 + 0;
		    $char{'bbx_x'} = $3;
		    $char{'bbx_y'} = $4 + $voffset;
		    $line = <BDF>;
		}elsif( $line =~ /^BITMAP/ ){
		    $char{'bmp'} = "\n";
		    $line = <BDF>;
		    while( $line !~ /^ENDCHAR/ ){
			$char{'bmp'} .= $line;
			$line = <BDF>;
		    }
		    chomp($char{'bmp'});
		    if( reducep( sprintf("%04X", $char{'enc'}) ) ){
			($char{'bmp'}, $char{'bbx_w'}) 
			    = reducemargin( $char{'bmp'}, $char{'bbx_w'} );
			$char{'dwidth'} = $char{'bbx_x'} + $char{'bbx_w'} + 1;
		    }
		    $count++;
		    $pct = int($count * 100 / $chars);
		    if( int($pct / 5) > $cbase ){
			$cbase = int($pct / 5);
			print "*";
		    }else{
			printf "%s\b", substr('/-\|', ($count % 4), 1);
		    }
		    if( ($char{'enc'} > 0) ){
			$char1  = sprintf("STARTCHAR U+%04X\n", $char{'enc'});
			$char1 .= sprintf("ENCODING %d\n", $char{'enc'});
			$char1 .= sprintf("SWIDTH %d 0\n", $char{'swidth'});
			$char1 .= sprintf("DWIDTH %d 0\n", $char{'dwidth'});
			$char1 .= sprintf("BBX %d %d %d %d\n", 
					  $char{'bbx_w'}, $char{'bbx_h'},
					  $char{'bbx_x'}, $char{'bbx_y'} );
			$char1 .= "BITMAP $char{'bmp'}\n";
			$char1 .= "ENDCHAR\n";
			$glyph{ $char{'enc'} + 0 } = $char1
			    if ( 0 < $char{'enc'} );
		    }
		}else{
		    $line = <BDF>;
		}
	    }
	}
	$line = <BDF>;
    }
    print "| done.\n";
}

getglyph($rk{'bdf'},  'JIS0201.TXT', $rk{'hoffset'},  $rk{'voffset'})
    if( defined($rk{'bdf'}) );
getglyph($asc{'bdf'}, 0,             $asc{'hoffset'}, $asc{'voffset'})
    if( ! $opt{'noascii'} );
getglyph($jis{'bdf'}, 'JIS0208.TXT', $jis{'hoffset'}, $jis{'voffset'})
    if( defined($jis{'bdf'}) );

#
# output
#
sub gen_bdf {
    my($file, $id, $w, $h, $x, $y, $uid) = @_;
    my($chars, $count, $cbase, $key, $pct);
    open(OUT, ">$file");
    print OUT <<EoH;
STARTFONT 2.1
FONT $id
SIZE $h 75 75
FONTBOUNDINGBOX $w $h $x $y
STARTPROPERTIES 4
UID $uid
MaxNormalCharWidth $w
Bold 0
Italic 0
ENDPROPERTIES
EoH

    $chars = 0 + keys(%glyph);
    printf "Merging to %-21s ... |--------------------|", $id;
    print "\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b";
    $count = 0;
    $cbase = 0;
    print OUT "CHARS $chars\n";
    foreach $key (sort {$a<=>$b} keys(%glyph)){
	$count++;
	$pct = int($count * 100 / $chars);
	if( int($pct / 5 ) > $cbase ){
	    $cbase = int($pct / 5);
	    print "*";
	}else{
	    printf "%s\b", substr('/-\|', ($count % 4), 1);
	}
	print OUT $glyph{$key};
    }
    print "| done.\n";
    print OUT "ENDFONT\n";
    close(OUT);
}

print "-----------------------------------------------------------------\n";

%typeface = ();
@outbdfs  = ();
if( $opt{'jp_both'} ){
    $out{'fontid'} = 'Japan';
    $typeface{'JapanPlain16'} = $out{'fontid'};
    $typeface{'JapanPlain12'} = $out{'fontid'};
    if( $out{'fbbx_h'} < 12 ){ $out{'fbbx_h'} = 12; }
    gen_bdf( $out{'bdf'}, $out{'fontid'},
 	     $out{'fbbx_w'}, $out{'fbbx_h'}, $out{'fbbx_x'}, $out{'fbbx_y'},
 	     $out{'uid'} );
    push( @outbdfs, $out{'bdf'} );
}else{
    $out{'size'} = $opt{'replace'} ? $opt{'replace'} : $out{'fbbx_h'};
    $typeface{$out{'fontid'}} = $out{'fontid'};
    gen_bdf( $out{'bdf'}, $out{'fontid'},
	     $out{'fbbx_w'}, $out{'size'}, $out{'fbbx_x'}, $out{'fbbx_y'},
	     $out{'uid'} );
    push( @outbdfs, $out{'bdf'} );
}


print "-----------------------------------------------------------------\n";
##################################################
# GD
##################################################
sub gen_gd{
    my($key);
    my(@keys) = keys(%typeface);
    open(GD, ">$out{'gd'}");
    foreach( @keys ){
	$key = $_;
	print GD qq(Typeface $key\n);
	print GD qq(  Name "$key" Proportional\n);
	print GD qq(  FontBitmaps\n);
	print GD qq(    $typeface{$key}\n);
	print GD qq(  EndFontBitmaps\n);
	print GD qq(EndTypeface\n\n);
    }
    print  GD qq(FontStoreFile\n);
    printf GD qq(  CollectionUid %d\n), genuid();
    print  GD qq(  KPixelAspectRatio 1000\n);
    print  GD qq(  CopyrightInfo\n);
    print  GD qq(    "Generated by bdf2gdr.pl and fnttran"\n);
    print  GD qq(  EndCopyrightInfo\n);
    print  GD qq(  Typefaces\n);
    foreach( @keys ){
	print GD qq(    $_\n);
    }
    print  GD qq(  EndTypefaces\n);
    print  GD qq(EndFontStoreFile\n\n);
    close(GD);
}

# %typefaces = ("$out{'fontid'}", "$out{'fontid'}");
gen_gd();

##################################################
# End
##################################################

$out{'bdfs'} = join(' ', @outbdfs);
$out{'cmd'} = "fnttran $out{'bdfs'} $out{'gd'} $out{'fontid'}.gdr";
$out{'msg'} = <<EoM;

	You've got unicode bdfs $out{'bdfs'} and gd file `$out{'gd'}'.
	The UID of the font is [$out{'uid'}].

	Okey, now run
	-------------------------------------------
	$out{'cmd'}
	-------------------------------------------
	and you will get `$out{'fontid'}.gdr' font file.  enjoy!
EoM
#`;

$status = 1;
if( $opt{'auto'} ){
    if( ! -w "$out{'fontid'}.gdr" ){
	$status = system( $out{'cmd'} );
	$status /= 256;
    }else{
	print "\n!!! WARNING !!!: $out{'fontid'} is already exists.  Fnttran is aborted.\n\n";
	$status = 1;
    }
}

if( !$status ){
    foreach( @outbdfs ){
	unlink( $_ );
    }
    unlink( "$out{'gd'}" );
    print "\n\tYou've got `$out{'fontid'}.gdr' font file.  enjoy!\n";
}else{
    print $out{'msg'};
}