#! /usr/bin/perl
use Font::Scripts::Thai;
use IO::File;
use Getopt::Std;

%attach_map = (
    'U' => 'US',
    'U1' => 'US',
    'L' => 'LS',
    'L1' => 'LS',
    'MARK_U' => 'UM',
    'MARK_U1' => 'UM',
    'MARK_L' => 'LM',
    'MARK_L1' => 'LM',
    );

%class_map = (
    'LS' => 'tldia',
    'LM' => 'ldia',
    'US' => 'tudia',
    'UM' => 'udia',
    );

getopts('a:ci:x:z');

unless (defined $ARGV[2])
{
    die <<'EOT';
    thai2gdl [-a angle] [-c] [-i basegdl] [-x xmlfile] fontfile gdlfile outfont
    Creates GDL for a Thai font.

    -a angle        Italic angle in degrees
    -c              Don't create U+25CC if not present
    -i basegdl      which .gdl file to include [thai.gdl]
    -x file         XML point database file for fontfile
    -z              Don't create U+200B (zwsp) if not present
EOT
}

$opt_i = "thai.gdl" unless ($opt_i);

$font = Font::Scripts::Thai->new($ARGV[0], $opt_c, $opt_z, $opt_a, $opt_x) || die "Can't open $ARGV[0]";
foreach $t (grep (m/^TS/, keys %{$font}))
{ delete $font->{$t}; }

$outfh = IO::File->new("> $ARGV[1]") || die "Can't create $ARGV[1]";

$outfh->print("/*\n    GDL Created for $ARGV[0] at " . scalar localtime() .
        "\n*/\n\ntable(glyph) {MUnits = $font->{'font'}{'head'}{'unitsPerEm'}};\n");
        
for ($i = 0; $i <= $#{$font->{'all_glyphs'}}; $i++)
{
    $glyphn = $font->{'all_glyphs'}[$i];
    $name = "$glyphn->{'name'}";
    $glyph = $font->{'glyphs'}{$name};
    $name = "g$name";
    if ($glyphn->{'unicode'}[0])
    { $res = "$name = unicode(" . sprintf("0x%04X)", $glyphn->{'unicode'}[0]); }
    else
    { $res = "$name = glyphid($i)"; }
    $pre = " {";

    foreach $k (keys %attach_map)
    {
        next unless ($glyph->{'anchor'}{$k});
        next if ($glyph->{'attaches'}{$attach_map{$k}});
        push (@{$classes{$attach_map{$k}}}, $name);
        $res .= "$pre$attach_map{$k} = point($glyph->{'anchor'}{$k}[0]m, $glyph->{'anchor'}{$k}[1]m)";
        $glyph->{'attaches'}{$attach_map{$k}} = 1;
        $pre = '; ';
    }
    if ($glyph->{'kern'}{'tall-udia'})
    {
        $res .= "${pre}tkern = $glyph->{'kern'}{'tall-udia'}m";
        $pre = '; ';
        push(@{$classes{'kern'}}, $name);
    }
    if ($glyph->{'kern'}{'stem'})
    {
        $have_skern = 1;
        $res .= "${pre}skern = $glyph->{'kern'}{'stem'}m";
        $pre = '; ';
	push(@{$classes{'skern'}}, $name);
    }
    $res .= "}" if ($pre eq '; ');
    $outfh->print("$res;\n");
}

foreach $k (keys %class_map)
{
    $outfh->print("\n" . list_class($classes{$k}, $class_map{$k}));
}

$outfh->print("\n#define has_zwsp\n") if ($font->{'font'}{'cmap'}->read->ms_lookup(0x200b));
$outfh->print("\n#define has_ckern\n" . list_class($classes{'kern'}, 'cKern')) if ($classes{'kern'});
$outfh->print("\n#define has_skern\n" . list_class($classes{'skern'}, 'cpreK')) if ($have_skern);
$outfh->print("endtable;\n\n#include \"$opt_i\"\n");
$outfh->close;

$font->{'font'}->out($ARGV[2]);

sub list_class
{
    my ($list, $name) = @_;
    my ($out, $res, $offset, $g);
    
    $out = "$name = (";
    $res = '';
    $offset = length($res) - 4;
    foreach $g (@{$list})
    {
        $res .= "$g ";
        if (length($res) > 75)
        {
            chop $res;
            $out .= "$res\n";
            $res = " " x $offset;
        }
    }
    if (length($res) > $offset)
    {
        chop $res;
        $out .= $res;
    }
    $out .= ");\n";
    $out;
}


