#! perl -w
use strict;
$|++;

use constant TRUE  => (0==0);
use constant FALSE => (0==1);
use Cwd;

use constant DEBUG => 1;

##
## Recherche de fichiers *.ttf dans le répertoire courrant
##

print STDERR "Looking for TTF fonts in the current directory\n" if DEBUG;
opendir(ROOT_DIR, '.') || die "Cannot read cirrent directory: $!";
while(my $file = readdir(ROOT_DIR)){
  next unless $file =~ m/\.tt[fc]$/i;
  print STDERR "  Found font $file\n" if DEBUG;
  process_font($file);
}
closedir(ROOT_DIR);
print STDERR "Finished looking for TTF fonts in the current directory\n" if DEBUG;
print STDERR "Look in the various directories that have been created.
You will find sample files (*.tex, which you can compile with latex
resp. lambda, *.dvi, which you may view and convert to Postscript with
xdvi and dvips, resp. oxdvi and odvips, *.ps which you may view with
Ghostview or print.
You will also find a `Makefile' file, that should install
the various files where they belong to (but you had better check
it before using it).\n\n";

##
## Trouve le nom complet de la fonte
##

sub get_font_name {
  my $file = shift;
  my $result = $file;
  $result =~ s/\.tt[fc]$//;

  open(AFM, "ttf2afm $file|") || die "Cannot run `ttf2afm $file': $!";
  while(<AFM>){
    if(m/^FontName\s+(.*)/){
      $result = $1;
      print STDERR "    Font $file has name $result\n" if DEBUG;
      last;
    }
  }
  close AFM;

  return $result;
}

##
## Crée quelques fichiers
##

sub create_file_from_script {
  my ($file, $function, $before, $after) = @_;
  print STDERR "    Creating file $file\n" if DEBUG;
  open(F, '>', $file) || die "cannot open $file for writing: $!";
  my $a = &$function;
  $a =~ s/$before/$after/g;
  print F $a;
  close(F);
}

sub create_a_few_files {
  my $font = shift;
  my @a = ('cyberb', $font);
  create_file_from_script("Unicode.sfd", \&print_unicode_sdf, @a);
  create_file_from_script("utf8_cjk.tex", \&print_utf8_cjk_tex, @a);
  create_file_from_script("c70$font.fd", \&print_c70song_fd, @a);
  create_file_from_script("utf8_omega.tex", \&print_utf8_omega_tex, @a);
  create_file_from_script("Makefile", \&print_makefile, @a);
}

##
## Traitement d'un fichier TTF
##

sub process_font {
  my $file = shift;

  my $basename = $file;
  $basename =~ s/\.ttf$//i;

  my $font = get_font_name($file);
  my $latex_font_name = $font;
  $latex_font_name =~ s/[^a-zA-Z0-9]//g;
  $latex_font_name =~ y/A-Z/a-z/;

  print STDERR "  Processing font $font ($latex_font_name) in file $file\n" 
    if DEBUG;
  my $rep = "0_tmp_$basename";
  mkdir $rep || die "Cannot mkdir $rep: $!";
  my $olddir = cwd;
  chdir $rep || die "Cannot chdir to $rep: $!";
  symlink("../$file", "./$file");
  create_a_few_files($latex_font_name);

  print STDERR "    Creating TeX metrics *.tfm with ttf2tfm\n" if DEBUG;
  open(TTF2TFM, "ttf2tfm $file $latex_font_name\@Unicode\@|") ||
    die "Cannot run ttf2tfm: $!";
  my $last;
  while(<TTF2TFM>){
    $last = $_;
  }
  close TTF2TFM;
  print STDERR "    Adding the following line to ttfonts.map\n" if DEBUG;
  print STDERR "      $last" if DEBUG;
  open(TTFONTS_MAP, '>', "ttfonts.map") ||
    die "Cannot open ttfonts.map for writing: $!";
  print TTFONTS_MAP $last;
  close TTFONTS_MAP;

  print STDERR "    Precompiling the bitmaps at 10 and 12 points
      These are the files, containing the actual picture of the
      characters, used by dvips and xdvi.
      They are automatically created by dvips or xdvi when
      needed, but as it takes some time, it is better to precompute
      them. You should go and get some coffee.\n" if DEBUG;
  opendir(DIR, ".") || die "Cannot open current directory: $!";
  while(my $f = readdir(DIR)){
    next unless $f =~ s/\.tfm$//;
    system("ttf2pk", "-q", $f, "720");
    system("ttf2pk", "-q", $f, "600");
  }
  closedir(DIR);
  print STDERR "    Finished precompiling the bitmaps\n" if DEBUG;

  print STDERR "    Compiling a sample file with LaTeX+CJK
      You should be able to view the result with
        xdvi utf8_cjk.dvi
      or
        gv utf8_cjk.ps
      The code is in the utf8_cjk.tex: to use LaTeX with CJK,
      you just have to adapt it.\n" if DEBUG;
  system(qw/latex --interaction=batchmode utf8_cjk.tex/);
  system(qw/dvips -E -o utf8_cjk.ps utf8_cjk.dvi/);
  print STDERR "    Finished compiling a sample file with LaTeX+CJK\n" if DEBUG;

##
## Omega
##

  print STDERR "  So far, you may use the $font font with LaTeX+CJK\n" if DEBUG;
  print STDERR "  We shall now install the font for use under Omega\n" if DEBUG;

  print STDERR "    Making *.pl files from *.tfm files.
      These file contain exactly the same thing, but
      the former is human-readable\n" if DEBUG;
  opendir(DIR, ".");
  while(my $f = readdir(DIR)){
    next unless $f =~ s/\.tfm$//;
    system("tftopl", "$f.tfm", "$f.pl");
  }
  closedir(DIR);

  print STDERR "    Creating *.ovp file\n" if DEBUG;
  my $data = "";
  my $def = "";
  my $head = "(VTITLE '$font' Omega font)
(OFMLEVEL H 1)
(FAMILY om". substr($latex_font_name, 0, 16) .")
(FACE F MRR)
(SEVENBITSAFEFLAG TRUE)";
  my $head_done = FALSE;

  # Lecture des 255 fichiers
  # $i : numéro de la sous-fonte (il y a des trous dans cette manière de compter)
  # $n : idem, sans trous
  my $n = 0;
  my $n_hex = sprintf("%02x", $n);
  for(my $i=0; $i<255; $i++){

    # On essaye d'ouvrir la sous-fonte
    my $i_hex = sprintf("%02x", $i);
    unless( open(PL, '<', "$latex_font_name$i_hex.pl") ){
      print STDERR "      skipping $latex_font_name$i_hex.pl: $!\n"
        if DEBUG;
      next;
    }
    local $/;
    my $pl = <PL>;

    # Si le fichier est là, on l'indique
    $def .= "(MAPFONT D $n
   (FONTNAME $latex_font_name$i_hex)
   (FONTAT R 1.0)
   (FONTDSIZE R 10.0)
   )\n";

    # Si c'est la première fois, on termine de construire l'en-tête
    unless($head_done){
      if( $pl =~ m/^(\(CODINGSCHEME.*?\))/m ){
        my $a = "$1\n";
        if( $pl =~ m/^(\(DESIGNSIZE.*?\))/m ){
          $a .= "$1\n";
          if( $pl =~ m/^(\(FONTDIMEN.*?^\s*\))/sm ){
            $a .= "$1\n";
            $head_done = TRUE;
            $head .= $a;
          }
        }
      }
    }

    $data .= "(COMMENT Begin om$latex_font_name$i_hex)\n";

    # On regarde les caractères un par un
    while( $pl =~ s/^\(CHARACTER ([OC]) ([^\s]+)(.*?)^\s*\)//sm ){
      my($type, $value, $parameters) = ($1, $2, $3);

      # Quel est le numéro (hexadécimal, unicode) du caractère ?
      my $decimal;
      if( $type eq "O" ){ $decimal = oct($value) }
      else{ $decimal = ord($value) }
      my $octal = sprintf("%o", $decimal);
      my $hex = $i_hex . sprintf("%02x", $decimal);

      $data .= "(CHARACTER H $hex$parameters   (MAP
      (SELECTFONT D $n)
      (SETCHAR $type $value)
      )
   )\n";
    }

    $n++;
    $n_hex = sprintf("%02x", $n);
  }

  open(OVP, '>', "om$latex_font_name.ovp") ||
    die "Cannot open om$latex_font_name.ovp for writing";
  print OVP $head;
  print OVP $def;
  print OVP $data;
  close OVP;

  print STDERR "    Creating om$latex_font_name.ovf from om$latex_font_name.ovp\n" if DEBUG;
  system("ovp2ovf om$latex_font_name");

  print STDERR "    Compiling sample file\n" if DEBUG;
  system(qw/lambda utf8_omega.tex/);
  system(qw/odvips -o utf8_omega.ps utf8_omega.dvi/);

  chdir $olddir || die "Cannot chdir back to $olddir";
  print STDERR "  Finished processing font $font in file $file\n" if DEBUG;
  print STDERR "  There is a `Makefile' file in the directory.
  You should check it if you want to use or install the font.\n" if DEBUG;
}

######################################################################

##
## Fichiers
##

sub print_utf8_cjk_tex {
  '\documentclass[12pt]{article}
\usepackage{CJK}
\usepackage[T1]{fontenc}
% we want the Unicode font for normal text also
\DeclareFontFamily{T1}{cyberb}{}
\DeclareFontShape{T1}{cyberb}{m}{n}{<-> cyberb00}{}
\renewcommand\rmdefault{cyberb}
\pagestyle{empty}
\begin{document}
\begin{CJK}{UTF8}{cyberb}
  Du texte accentué, en français.

  これは日本語でのサンプル文章です。
\end{CJK}
\end{document}';
}

sub print_utf8_omega_tex {
  '\ocp\TexUTF=inutf8
\InputTranslation currentfile \TexUTF
\documentclass[12pt]{article}
\usepackage[T1]{fontenc}
\DeclareFontFamily{T1}{cyberb}{}
\DeclareFontShape{T1}{cyberb}{m}{n}{<-> omcyberb}{}
\def\cyberb{\fontfamily{cyberb}\selectfont}
\pagestyle{empty}
\begin{document}
  Du texte accentué, en français.
\begin{cyberb}
  これは日本語でのサンプル文章です。
\end{cyberb}
\end{document}';
}

sub print_unicode_sdf {
  '# Unicode.sfd
#
# subfont numbers for Unicode encoding and its corresponding code ranges
# to be used with the CJK package for LaTeX.

00  0x0_0xFF
01  0x100_0x1FF
02  0x200_0x2FF
03  0x300_0x3FF
04  0x400_0x4FF
05  0x500_0x5FF
06  0x600_0x6FF
07  0x700_0x7FF
08  0x800_0x8FF
09  0x900_0x9FF
0a  0xA00_0xAFF
0b  0xB00_0xBFF
0c  0xC00_0xCFF
0d  0xD00_0xDFF
0e  0xE00_0xEFF
0f  0xF00_0xFFF
10  0x1000_0x10FF
11  0x1100_0x11FF
12  0x1200_0x12FF
13  0x1300_0x13FF
14  0x1400_0x14FF
15  0x1500_0x15FF
16  0x1600_0x16FF
17  0x1700_0x17FF
18  0x1800_0x18FF
19  0x1900_0x19FF
1a  0x1A00_0x1AFF
1b  0x1B00_0x1BFF
1c  0x1C00_0x1CFF
1d  0x1D00_0x1DFF
1e  0x1E00_0x1EFF
1f  0x1F00_0x1FFF
20  0x2000_0x20FF
21  0x2100_0x21FF
22  0x2200_0x22FF
23  0x2300_0x23FF
24  0x2400_0x24FF
25  0x2500_0x25FF
26  0x2600_0x26FF
27  0x2700_0x27FF
28  0x2800_0x28FF
29  0x2900_0x29FF
2a  0x2A00_0x2AFF
2b  0x2B00_0x2BFF
2c  0x2C00_0x2CFF
2d  0x2D00_0x2DFF
2e  0x2E00_0x2EFF
2f  0x2F00_0x2FFF
30  0x3000_0x30FF
31  0x3100_0x31FF
32  0x3200_0x32FF
33  0x3300_0x33FF
34  0x3400_0x34FF
35  0x3500_0x35FF
36  0x3600_0x36FF
37  0x3700_0x37FF
38  0x3800_0x38FF
39  0x3900_0x39FF
3a  0x3A00_0x3AFF
3b  0x3B00_0x3BFF
3c  0x3C00_0x3CFF
3d  0x3D00_0x3DFF
3e  0x3E00_0x3EFF
3f  0x3F00_0x3FFF
40  0x4000_0x40FF
41  0x4100_0x41FF
42  0x4200_0x42FF
43  0x4300_0x43FF
44  0x4400_0x44FF
45  0x4500_0x45FF
46  0x4600_0x46FF
47  0x4700_0x47FF
48  0x4800_0x48FF
49  0x4900_0x49FF
4a  0x4A00_0x4AFF
4b  0x4B00_0x4BFF
4c  0x4C00_0x4CFF
4d  0x4D00_0x4DFF
4e  0x4E00_0x4EFF
4f  0x4F00_0x4FFF
50  0x5000_0x50FF
51  0x5100_0x51FF
52  0x5200_0x52FF
53  0x5300_0x53FF
54  0x5400_0x54FF
55  0x5500_0x55FF
56  0x5600_0x56FF
57  0x5700_0x57FF
58  0x5800_0x58FF
59  0x5900_0x59FF
5a  0x5A00_0x5AFF
5b  0x5B00_0x5BFF
5c  0x5C00_0x5CFF
5d  0x5D00_0x5DFF
5e  0x5E00_0x5EFF
5f  0x5F00_0x5FFF
60  0x6000_0x60FF
61  0x6100_0x61FF
62  0x6200_0x62FF
63  0x6300_0x63FF
64  0x6400_0x64FF
65  0x6500_0x65FF
66  0x6600_0x66FF
67  0x6700_0x67FF
68  0x6800_0x68FF
69  0x6900_0x69FF
6a  0x6A00_0x6AFF
6b  0x6B00_0x6BFF
6c  0x6C00_0x6CFF
6d  0x6D00_0x6DFF
6e  0x6E00_0x6EFF
6f  0x6F00_0x6FFF
70  0x7000_0x70FF
71  0x7100_0x71FF
72  0x7200_0x72FF
73  0x7300_0x73FF
74  0x7400_0x74FF
75  0x7500_0x75FF
76  0x7600_0x76FF
77  0x7700_0x77FF
78  0x7800_0x78FF
79  0x7900_0x79FF
7a  0x7A00_0x7AFF
7b  0x7B00_0x7BFF
7c  0x7C00_0x7CFF
7d  0x7D00_0x7DFF
7e  0x7E00_0x7EFF
7f  0x7F00_0x7FFF
80  0x8000_0x80FF
81  0x8100_0x81FF
82  0x8200_0x82FF
83  0x8300_0x83FF
84  0x8400_0x84FF
85  0x8500_0x85FF
86  0x8600_0x86FF
87  0x8700_0x87FF
88  0x8800_0x88FF
89  0x8900_0x89FF
8a  0x8A00_0x8AFF
8b  0x8B00_0x8BFF
8c  0x8C00_0x8CFF
8d  0x8D00_0x8DFF
8e  0x8E00_0x8EFF
8f  0x8F00_0x8FFF
90  0x9000_0x90FF
91  0x9100_0x91FF
92  0x9200_0x92FF
93  0x9300_0x93FF
94  0x9400_0x94FF
95  0x9500_0x95FF
96  0x9600_0x96FF
97  0x9700_0x97FF
98  0x9800_0x98FF
99  0x9900_0x99FF
9a  0x9A00_0x9AFF
9b  0x9B00_0x9BFF
9c  0x9C00_0x9CFF
9d  0x9D00_0x9DFF
9e  0x9E00_0x9EFF
9f  0x9F00_0x9FFF
a0  0xA000_0xA0FF
a1  0xA100_0xA1FF
a2  0xA200_0xA2FF
a3  0xA300_0xA3FF
a4  0xA400_0xA4FF
a5  0xA500_0xA5FF
a6  0xA600_0xA6FF
a7  0xA700_0xA7FF
a8  0xA800_0xA8FF
a9  0xA900_0xA9FF
aa  0xAA00_0xAAFF
ab  0xAB00_0xABFF
ac  0xAC00_0xACFF
ad  0xAD00_0xADFF
ae  0xAE00_0xAEFF
af  0xAF00_0xAFFF
b0  0xB000_0xB0FF
b1  0xB100_0xB1FF
b2  0xB200_0xB2FF
b3  0xB300_0xB3FF
b4  0xB400_0xB4FF
b5  0xB500_0xB5FF
b6  0xB600_0xB6FF
b7  0xB700_0xB7FF
b8  0xB800_0xB8FF
b9  0xB900_0xB9FF
ba  0xBA00_0xBAFF
bb  0xBB00_0xBBFF
bc  0xBC00_0xBCFF
bd  0xBD00_0xBDFF
be  0xBE00_0xBEFF
bf  0xBF00_0xBFFF
c0  0xC000_0xC0FF
c1  0xC100_0xC1FF
c2  0xC200_0xC2FF
c3  0xC300_0xC3FF
c4  0xC400_0xC4FF
c5  0xC500_0xC5FF
c6  0xC600_0xC6FF
c7  0xC700_0xC7FF
c8  0xC800_0xC8FF
c9  0xC900_0xC9FF
ca  0xCA00_0xCAFF
cb  0xCB00_0xCBFF
cc  0xCC00_0xCCFF
cd  0xCD00_0xCDFF
ce  0xCE00_0xCEFF
cf  0xCF00_0xCFFF
d0  0xD000_0xD0FF
d1  0xD100_0xD1FF
d2  0xD200_0xD2FF
d3  0xD300_0xD3FF
d4  0xD400_0xD4FF
d5  0xD500_0xD5FF
d6  0xD600_0xD6FF
d7  0xD700_0xD7FF
# Surrogates
#
# d8  0xD800_0xD8FF
# d9  0xD900_0xD9FF
# da  0xDA00_0xDAFF
# db  0xDB00_0xDBFF
dc  0xDC00_0xDCFF
dd  0xDD00_0xDDFF
de  0xDE00_0xDEFF
df  0xDF00_0xDFFF
e0  0xE000_0xE0FF
e1  0xE100_0xE1FF
e2  0xE200_0xE2FF
e3  0xE300_0xE3FF
e4  0xE400_0xE4FF
e5  0xE500_0xE5FF
e6  0xE600_0xE6FF
e7  0xE700_0xE7FF
e8  0xE800_0xE8FF
e9  0xE900_0xE9FF
ea  0xEA00_0xEAFF
eb  0xEB00_0xEBFF
ec  0xEC00_0xECFF
ed  0xED00_0xEDFF
ee  0xEE00_0xEEFF
ef  0xEF00_0xEFFF
f0  0xF000_0xF0FF
f1  0xF100_0xF1FF
f2  0xF200_0xF2FF
f3  0xF300_0xF3FF
f4  0xF400_0xF4FF
f5  0xF500_0xF5FF
f6  0xF600_0xF6FF
f7  0xF700_0xF7FF
f8  0xF800_0xF8FF
f9  0xF900_0xF9FF
fa  0xFA00_0xFAFF
fb  0xFB00_0xFBFF
fc  0xFC00_0xFCFF
fd  0xFD00_0xFDFF
fe  0xFE00_0xFEFF
ff  0xFF00_0xFFFF

# eof';
}

sub print_c70song_fd {
  '\ProvidesFile{c70cyberb.fd}
% character set: Unicode U+0080 - U+FFFD
% font encoding: Unicode

\DeclareFontFamily{C70}{cyberb}{\hyphenchar \font\m@ne}
\DeclareFontShape{C70}{cyberb}{m}{n}{<-> CJK * cyberb}{}
\DeclareFontShape{C70}{cyberb}{bx}{n}{<-> CJKb * cyberb}{\CJKbold}

\endinput';
}

sub print_makefile {
  'all:
	latex utf8_cjk.tex
	-xdvi utf8_cjk.dvi
	dvips -E -o utf8_cjk.ps utf8_cjk.dvi
	gv utf8_cjk.ps
	lambda utf8_omega.tex
	-oxdvi utf8_omega.dvi
	odvips -o utf8_omega.ps utf8_omega.dvi
	gv utf8_omega.ps
	
install:
	TEXMF=/usr/local/lib/texmf
	mkdir $TEXMF/fonts/tfm/font_install_unicode
	cp *.tfm $TEXMF/fonts/tfm/font_install_unicode/
	mkdir $TEXMF/tex/generic/font_install_unicode
	cp *.fd $TEXMF/tex/generic/font_install_unicode/
	cp -H *.ttf $TEXMF/tex/fonts/truetype/
	cp ttfonts.map $TEXMF/tex/fonts/truetype/cyberb.map
	cat ttfonts.map >> $TEXMF/tex/fonts/truetype/ttfonts.map
	mkdir $TEXMF/fonts/ofm/public/font_install_unicode
	cp *.ofm $TEXMF/fonts/ofm/public/font_install_unicode/
	mkdir $TEXMF/fonts/ovp/public/font_install_unicode
	cp *.ovp $TEXMF/fonts/ovp/public/font_install_unicode/
';
}