package Font::TTF::Scripts::Thai;

use strict;
use vars qw(%class);
use IO::File;
use Font::TTF::Font;
use Font::TTF::Glyph;
use XML::Parser;

BEGIN
{
    my ($i) = 0;
    my (@unis) = (0x0e01 .. 0x0e3a, 0x0e3f .. 0x0e5b, 0xf700 .. 0xf71a, 0x25cc, 0x200b);

    %class = (
    'unis' => [@unis],
    'symb' => [0xf0a1 .. 0xf0da, 0xf0df .. 0xf0fb, 0xf080 .. 0xf084, 0xf086 .. 0xf090,
                0xf098 .. 0xf09f, 0xf0fc .. 0xf0fe, 0x25cc, 0x200b],
    'ansi' => [0x00a1 .. 0x00da, 0x00df .. 0x00fb, 0x20ac, 0x0081, 0x201a, 0x0192, 0x201e,
         0x2020, 0x2021, 0x02c6, 0x2030, 0x0160, 0x2039, 0x0152, 0x008d, 0x017d,
         0x008f, 0x0090, 0x02dc, 0x2122, 0x0161, 0x203a, 0x0153, 0x009d, 0x017e,
         0x0178, 0x00fc .. 0x00fe, 0x25cc, 0x200b],
    'ansi95' => [0x00a1 .. 0x00da, 0x00df .. 0x00fb, 0x0080, 0x0081, 0x201a, 0x0192, 0x201e,
         0x2020, 0x2021, 0x02c6, 0x2030, 0x0160, 0x2039, 0x0152, 0x008d, 0x008e,
         0x008f, 0x0090, 0x02dc, 0x2122, 0x0161, 0x203a, 0x0153, 0x009d, 0x009e,
         0x0178, 0x00fc .. 0x00fe, 0x25cc, 0x200b],

    'names' => {map {sprintf("uni%04x", $_) => $i++} @unis},

    'base_names' => [qw(space exclam quotedbl numbersign dollar percent ampersand quotesingle
     parenleft parenright asterisk plus comma hyphen period slash zero one two three four
     five six seven eight nine colon semicolon less equal greater question at A B C D E F
     G H I J K L M N O P Q R S T U V W X Y Z bracketleft backslash bracketright asciicircum
     underscore grave a b c d e f g h i j k l m n o p q r s t u v w x y z braceleft bar
     braceright asciitilde)],

     'upper_names' => [qw(space exclamdown cent sterling currency yen brokenbar section
     dieresis copyright ordfeminine guillemotleft logicalnot dash registered macron
     degree plusminus twosuperior threesuperior acute mu paragraph periodcentered
     cedilla onesuperior ordmasculine guillemotright onequarter onehalf threequarters
     questiondown Agrave Aacute Acircumflex Atilde Adieresis Aring AE Ccedilla Egrave
     Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex Idieresis Eth Ntilde Ograve
     Oacute Ocircumflex Otilde Odieresis multiply Oslash Ugrave Uacute Ucircumflex Udieresis
     Yacute Thorn germandbls agrave aacute acircumflex atilde adieresis aring ae ccedilla
     egrave eacute ecircumflex edieresis igrave iacute icircumflex idieresis eth ntilde
     ograve oacute ocircumflex otilde odieresis divide oslash ugrave uacute ucircumflex
     udieresis yacute thorn ydieresis)],

    'groups' => {
        'base_cons' => [map{sprintf("uni%04x", $_)} (0x0e01 .. 0x0e1a, 0x0e1c,
                    0x0e1e, 0x0e20 .. 0x0e2e, 0xf700, 0xf70f, 0x25cc)],
        'base_tall' => [qw(uni0e1b uni0e1d uni0e1f)],
        'base_low' => [qw(uni0e0d uni0e0e uni0e0f uni0e10 uni0e24 uni0e26)],
        'base_vowel' => [qw(uni0e30 uni0e32 uni0e40 uni0e41 uni0e42 uni0e43 uni0e44)],
        'base_kern' => [qw(uni0e42 uni0e43 uni0e44)],
        'udia' => [map{sprintf("uni%04x", $_)} (0x0e34 .. 0x0e37, 0x0e47 .. 0x0e4e, 0x0e31)],
        'udia_kern' => [qw(uni0e34 uni0e35 uni0e36 uni0e37)],
        'tones' => [qw(uni0e48 uni0e49 uni0e4a uni0e4b uni0e4c)],
        'ldia' => [qw(uni0e38 uni0e39 uni0e3a)],
        'am' => ['uni0e33'],
    }
    );
}

sub new
{
    my ($class, $fname, $opt_c, $opt_z, $opt_m, $xml_file) = @_;
    my ($self) = {};
    my ($font, $cmap, $k);

    bless $self, ref $class || $class;

    $font = $self->{'font'} = Font::TTF::Font->open($fname) || return warn "Can't open font $fname";
    $self->{'class'} = \%class;

    $cmap = $font->{'cmap'}->read->find_ms;

    unless (defined $cmap->{'val'}{0x0e01})
    {
        if (defined $cmap->{'val'}{0xf0a1})
        { $self->remap($cmap, $class->{'symb'}, $class->{'unis'}); }
        elsif (defined $cmap->{'val'}{0x0080})              # pre Win98 font
        { $self->remap($cmap, $class->{'ansi95'}, $class->{'unis'}); }
        else
        { $self->remap($cmap, $class->{'ansi'}, $class->{'unis'}); }
    }

    $font->{'hmtx'}->read;
    $font->{'loca'}->read;
    $font->{'post'}->read;
    
    fixps($font->{'post'}, $cmap);

    foreach $k (keys %{$class{'names'}})
    {
        my ($gid) = $cmap->{'val'}{$class{'unis'}[$class{'names'}{$k}]};
        $self->{'glyphs'}{$k} = {'gid' => $gid};
        $self->{'all_glyphs'}[$gid] = {'name' => $k,
                                       'unicode' => [$class{'unis'}[$class{'names'}{$k}]]} 
                if ($gid && !defined $self->{'all_glyphs'}[$gid]);
    }

    if ($opt_m)
    { $self->{'slant'} = sin($opt_m * 3.141592535 / 180) / cos($opt_m * 3.1415926535 / 180); }
    else
    { $self->{'slant'} = $self->get_slant(); }
#    print "Slant is " . atan2(1., $self->{'slant'}) * 180 / 3.1415926535 . "\n" if ($self->{'slant'});

    unless ($opt_c || $self->{'glyphs'}{'uni25cc'}{'gid'} != 0)
    { 
        my ($tgid) = $self->make_circle($cmap, $self->{'glyphs'}{'uni0e01'}{'gid'});
        
        $self->{'glyphs'}{'uni25cc'}{'gid'} = $tgid;
        $self->{'font'}{'post'}{'VAL'}[$tgid] = 'uni25cc';
        $self->{'all_glyphs'}[$tgid] = {'name' => 'uni25cc', 'unicode' => [0x25cc]};
    }

    unless ($opt_z || $self->{'glyphs'}{'uni200b'}{'gid'} != 0)
    {
        my ($tgid) = $self->{'font'}{'maxp'}->read->{'numGlyphs'}++;
        
        $self->{'font'}{'hmtx'}{'advance'}[$tgid] = 0;
        $self->{'font'}{'hmtx'}{'lsb'}[$tgid] = 0;
        $cmap->{'val'}{0x200b} = $tgid;
        $self->{'font'}{'post'}{'VAL'}[$tgid] = 'uni200b';
        $self->{'all_glyphs'}[$tgid] = {'name' => 'uni200b', 'unicode' => [0x200b]};
    }

    foreach $k (sort keys %{$cmap->{'val'}})
    {
        my ($gid) = $cmap->{'val'}{$k};
        if ($self->{'all_glyphs'}[$gid])
        { push (@{$self->{'all_glyphs'}[$gid]{'unicode'}}, $k)
                unless ($k eq $self->{'all_glyphs'}[$gid]{'unicode'}[0]); }
        elsif ($k < 127 && $k > 31)
        { $self->{'all_glyphs'}[$gid] = {'name' => $class{'base_names'}[$k - 32], 'unicode' => [$k]}; }
        elsif ($k > 160 && $k < 256)
        { $self->{'all_glyphs'}[$gid] = {'name' => $class{'upper_names'}[$k - 160], 'unicode' => [$k]}; }
        else
        { $self->{'all_glyphs'}[$gid] = {'name' => sprintf("uni%04x", $k), 'unicode' => [$k]}; }
    }
    
    for ($k = 0; $k < $font->{'maxp'}{'numGlyphs'}; $k++)
    { $self->{'all_glyphs'}[$k] = {'name' => sprintf("glyph%03d", $k)} unless ($self->{'all_glyphs'}[$k]); }

    foreach $k (@{$class{'groups'}{'udia'}}, @{$class{'groups'}{'ldia'}})
    { $self->{'all_glyphs'}[$self->{'glyphs'}{$k}{'gid'}]{'type'} = 'MARK'; }

    if ($xml_file)
    { $self->get_attach($xml_file); }
    else
    { $self->make_attach; }
    $self->make_kern;
    $self;
}

sub get_slant
{
    my ($self) = @_;
    my ($maiek) = $self->{'font'}{'loca'}{'glyphs'}[$self->{'glyphs'}{'uni0e48'}{'gid'}]->read;
    my ($maiekn) = $self->{'font'}{'loca'}{'glyphs'}[$self->{'glyphs'}{'unif70a'}{'gid'}]->read;

    if ($self->{'font'}{'hhea'}->read->{'caretSlopeRise'})
    { return $self->{'font'}{'hhea'}{'caretSlopeRun'} / $self->{'font'}{'hhea'}{'caretSlopeRise'}; }
    
    return ($maiek->{'xMax'} - $maiekn->{'xMax'}) / ($maiek->{'yMax'} - $maiekn->{'yMax'});
}


sub make_attach
{
    my ($self) = @_;
    my ($locas) = $self->{'font'}{'loca'}{'glyphs'};
    my ($hmtx) = $self->{'font'}{'hmtx'};
    my ($class) = $self->{'class'};
    my ($glyphs) = $self->{'glyphs'};
    my ($maiekn) = $locas->[$glyphs->{'unif70a'}{'gid'}]->read->{'yMin'};
    my ($maieknx) = $locas->[$glyphs->{'unif70a'}{'gid'}]->read->{'xMax'};
    my ($maieklx) = $locas->[$glyphs->{'unif705'}{'gid'}]->read->{'xMax'};
    my ($maiek) = $locas->[$glyphs->{'uni0e48'}{'gid'}]->read->{'yMin'};
    my ($sarau) = $locas->[$glyphs->{'uni0e38'}{'gid'}]->read->{'yMax'};
    my ($saraul) = $locas->[$glyphs->{'unif718'}{'gid'}]->read->{'yMax'};
    my ($m) = $self->{'slant'};
    my ($k, $uadv, $ladv, $gid, $upper, $lower);

    foreach $k (@{$class->{'groups'}{'base_cons'}}, @{$class->{'groups'}{'base_tall'}},
                @{$class->{'groups'}{'base_vowel'}})
    {
        $gid = $glyphs->{$k}{'gid'};
        if (grep {$_ eq $k} @{$class->{'groups'}{'base_tall'}})
        { $uadv = $hmtx->{'advance'}[$gid] + $maieklx - $maieknx; }
        else
        { $uadv = $hmtx->{'advance'}[$gid]; }

        if (grep {$_ eq $k} @{$class->{'groups'}{'base_low'}})
        { $ladv = $saraul - $sarau; }
        else
        { $ladv = 0; }

        $glyphs->{$k}{'anchor'} = {
            'U' => [$uadv, $maiekn],
            'L' => [int($hmtx->{'advance'}[$gid] + $m * $ladv), $ladv]};
    }

    foreach $k (@{$class->{'groups'}{'udia'}})
    {
        my ($xl, $xu);
        if (grep {$_ eq $k} @{$class->{'groups'}{'tones'}})
        { 
            $lower = $maiek; $upper = 2 * $maiek - $maiekn; 
            $xl = int($m * ($maiek - $maiekn)); $xu = 2 * $xl;
        }
        else
        { 
            $lower = $maiekn; $upper = $maiek; 
            $xl = 0; $xu = int($m * ($maiek - $maiekn));
        }
        $glyphs->{$k}{'anchor'} = {
            'MARK_U' => [$xl, $lower],
            'MARK_U1' => [$xl, $lower],
            'U1' => [$xu, $upper]};
    }

    foreach $k (@{$class->{'groups'}{'ldia'}})
    {
        $glyphs->{$k}{'anchor'} = {
            'MARK_L' => [0, 0],
            'MARK_L1' => [0, 0],
            'L1' => [int($m * ($saraul - $sarau)), $saraul - $sarau]};
    }
    $self->{'slant'} = $m;
}


sub make_kern
{
    my ($self) = @_;
    my ($locas) = $self->{'font'}{'loca'}{'glyphs'};
    my ($hmtx) = $self->{'font'}{'hmtx'};
    my ($class) = $self->{'class'};
    my ($glyphs) = $self->{'glyphs'};
    my ($maieklx) = $locas->[$glyphs->{'unif705'}{'gid'}]->read->{'xMax'};
    my ($maieknx) = $locas->[$glyphs->{'unif70a'}{'gid'}]->read->{'xMax'};
    my ($saraim) = $locas->[$glyphs->{'uni0e35'}{'gid'}]->read->{'xMin'};
    my ($widi) = $hmtx->{'advance'}[$glyphs->{'uni0e35'}{'gid'}] - $saraim;
    my ($rsb) = $hmtx->{'advance'}[$glyphs->{'uni0e1b'}{'gid'}] -
        $locas->[$glyphs->{'uni0e1b'}{'gid'}]->read->{'xMax'};
    my ($rsbm) = $hmtx->{'advance'}[$glyphs->{'uni0e31'}{'gid'}] -
        $locas->[$glyphs->{'uni0e31'}{'gid'}]->read->{'xMax'};
    my ($m) = $self->{'slant'};
    my ($maiekn) = $locas->[$glyphs->{'unif70a'}{'gid'}]{'yMin'};
    my ($k, $gid, $uadv);

    $rsbm = ($rsbm < 0) ? -$rsbm : 0;
    foreach $k (@{$class->{'groups'}{'base_cons'}}, @{$class->{'groups'}{'base_tall'}})
    {
        $gid = $glyphs->{$k}{'gid'};
        if (grep {$_ eq $k} @{$class->{'groups'}{'base_tall'}})
        { $uadv = $hmtx->{'advance'}[$gid] + $maieklx - $maieknx; }
        else
        { $uadv = $hmtx->{'advance'}[$gid]; }
        $uadv += int($m * $maiekn);
#        $glyphs->{$k}{'kern'}{'tall-udia'} = int(($hmtx->{'lsb'}[$gid] - $rsb) / 2 - $uadv - $saraim)
#            if ($uadv + $saraim <= -$rsb);
        $glyphs->{$k}{'kern'}{'tall-udia'} = ($widi + $rsbm - $uadv) if ($widi + $rsbm > $uadv);
    }
    
    foreach $k (@{$class->{'groups'}{'base_kern'}})
    {
        my ($cuts, $dirs, $adv, $trsb, $xmin, $xmax, $i, $ytest, $glyph);
        
        $gid = $glyphs->{$k}{'gid'};
        $glyph = $locas->[$gid]->read;
        $ytest = ($glyph->{'yMax'} + $glyph->{'yMin'}) * .5;
        $adv = $hmtx->{'advance'}[$gid];
        $xmin = int($adv + $m * $ytest);
        ($cuts, $dirs) = $self->cut($gid, 0.5);
        for ($i = 0; $i < scalar @{$cuts}; $i++)
        {
            $xmin = int($cuts->[$i]) if ($dirs->[$i] && $cuts->[$i] < $xmin);
            $xmax = int($cuts->[$i]) if (!$dirs->[$i] && $cuts->[$i] > $xmax);
        }
        $glyphs->{$k}{'kern'}{'stem'} = int($xmin - $adv + $xmax - $m * $ytest);   #  - 2 * $m * $ytest;
    }
    
    foreach $k (@{$class->{'groups'}{'udia'}})
    {
        my ($glyph, $adv);
        
        $gid = $glyphs->{$k}{'gid'};
        $glyph = $locas->[$gid]->read;
        $adv = int($hmtx->{'advance'}[$gid] + $m * $glyph->{'xMin'});        # guess! take the smallest gap (xMax for biggest kern)
        if ($glyph->{'xMax'} > $adv)
        {
            $glyphs->{$k}{'kern'}{'udia'} = $glyph->{'xMax'} - $adv;
        }
    }
}


sub make_circle
{
    my ($self, $cmap, $kid) = @_;
    my ($font) = $self->{'font'};
    my ($dia) = $font->{'loca'}{'glyphs'}[$kid]->read->{'yMax'} * .95;
    my ($upem) = $font->{'head'}{'unitsPerEm'};
    my ($glyph) = Font::TTF::Glyph->new('PARENT' => $font, 'read' => 2);
    my ($PI) = 3.1415926535;
    my ($R) = $dia / 2;
    my ($r) = $R * 0.1;
    my ($xorg, $yorg) = ($dia / 2 + $r, $dia / 2);
    my ($cwidth) = $font->{'hmtx'}->read->{'advance'}[$kid]
            - $font->{'loca'}{'glyphs'}[$kid]{'xMax'};
    my ($numcirc) = 16;
    my ($numcpt) = 8;
    my ($coutr) = 1. / cos($PI / $numcpt);
    my ($m) = $self->{'slant'};
    my ($i, $j, $numg, $maxp);

    $xorg += $cwidth;
    $font->{'post'}->read;
    $font->{'glyf'}->read;
    for ($i = 0; $i < $numcirc; $i++)
    {
        my ($pxorg, $pyorg) = ($xorg + $R * cos($PI * $i * 2. / $numcirc),
                               $yorg + $R * sin($PI * $i * 2. / $numcirc));
        $pxorg += $m * $pyorg;
        push (@{$glyph->{'x'}}, int($pxorg + $r));
        push (@{$glyph->{'y'}}, $pyorg);
        push (@{$glyph->{'flags'}}, 1);
        for ($j = 0; $j < $numcpt; $j++)
        {
#            push (@{$glyph->{'x'}}, int ($pxorg + ($j & 1 ? 1.414 : 1) * $r * cos($PI * $j * 2. / $numcpt)));
#            push (@{$glyph->{'y'}}, int ($pyorg + ($j & 1 ? 1.414 : 1) * $r * sin($PI * $j * 2. / $numcpt)));
#            push (@{$glyph->{'flags'}}, $j & 1 ? 0 : 1);
            push(@{$glyph->{'x'}}, int($pxorg + $coutr * $r * cos($PI * ($j + .5) * 2. / $numcpt)));
            push(@{$glyph->{'y'}}, int($pyorg + $coutr * $r * sin($PI * ($j + .5) * 2. / $numcpt)));
            push(@{$glyph->{'flags'}}, 0);
        }
        push (@{$glyph->{'endPoints'}}, $#{$glyph->{'x'}});
    }
    $glyph->{'numberOfContours'} = $#{$glyph->{'endPoints'}} + 1;
    $glyph->{'numPoints'} = $#{$glyph->{'x'}} + 1;
    $glyph->update;
    $font->{'maxp'}->read->{'numGlyphs'}++;
    $numg = $font->{'maxp'}{'numGlyphs'};

    $font->{'hmtx'}{'advance'}[$numg - 1] = int($xorg + $R + $r + $cwidth + .5);
    $font->{'hmtx'}{'lsb'}[$numg - 1] = int($xorg - $R - $r + .5);
    $font->{'loca'}{'glyphs'}[$numg - 1] = $glyph;
    $cmap->{'val'}{0x25CC} = $#{$font->{'loca'}{'glyphs'}};
    delete $font->{'hdmx'};
    delete $font->{'VDMX'};
    delete $font->{'LTSH'};
    
#    $maxp = $font->{'maxp'}->read;
#    $maxp->{'maxPoints'} = 128 unless ($maxp->{'maxPoints'} > 128);
#    $maxp->{'maxContours'} = 16 unless ($maxp->{'maxContours'} > 16);
#    $maxp->{'maxCompositePoints'} = 128 unless ($maxp->{'maxCompositePoints'} > 128);
#    $maxp->{'maxCompositeContours'} = 16 unless ($maxp->{'maxCompositeContours'} > 16);
    
    $font->tables_do(sub {$_[0]->dirty;});
    $font->update;
    return ($numg - 1);
}


sub get_attach
{
    my ($self, $xml_file) = @_;
    my ($font) = $self->{'font'};
    my ($cmap) = $font->{'cmap'}->find_ms;
    my ($post) = $font->{'post'}->read;
    my ($cur_glyph, $cur_point, $xml);
    
    $xml = XML::Parser->new(Handlers => {Start => sub {
        my ($xml, $tag, %attrs) = @_;
        my ($gid);
        
        if ($tag eq 'glyph')
        {
            $gid = $cmap->{'val'}{hex($attrs{'UID'})} || $post->{'STRINGS'}{$attrs{'PSName'}}
                    || $attrs{'GID'};
            $xml->xpcarp("Unknown glyph") unless $gid;
            $cur_glyph = $self->{'glyphs'}{$self->{'all_glyphs'}[$gid]{'name'}};
        }
        elsif ($tag eq 'point')
        { $cur_point = $attrs{'type'}; }
        elsif ($tag eq 'location')
        { $cur_glyph->{'anchor'}{$cur_point} = [$attrs{'x'}, $attrs{'y'}]; }
    }});
    
    $xml->parsefile($xml_file);
}


sub remap
{
    my ($self, $cmap, $from, $to) = @_;
    my ($font) = $self->{'font'};
    my ($k, $temp, $c);

    for ($k = 0; $k <= $#{$from}; $k++)
    {
        $temp = delete $cmap->{'val'}{$from->[$k]};
        $cmap->{'val'}{$to->[$k]} = $temp;
    }
    
    foreach $c (@{$font->{'cmap'}{'Tables'}})
    {
        $c->{'val'} = $cmap->{'val'} if ($c->{'Platform'} == 0 || $c->{'Platform'} == 3
            || ($c->{'Platform'} == 2 && $c->{'Encoding'} == 1));
        $c->{'Encoding'} = 1 if ($c->{'Platform'} == 3);
    }
}

sub fixps
{
    my ($self, $post, $cmap) = @_;
    my ($k, $newname, $oldname, $gid);
    
    foreach $k (keys %{$cmap->{'val'}})
    {
        $oldname = $post->{'VAL'}[$k];
        $newname = Font::TTF::PSNames::lookup($k);
        $gid = $cmap->{'val'}{$k};
        if ($oldname ne $newname)
        {
            if ($post->{'STRINGS'}{$oldname} == $gid)
            { 
                delete $post->{'STRINGS'}{$oldname};
                $post->{'STRINGS'}{$newname} = $gid;
            }
            $post->{'VAL'}[$k] = $newname;
        }
    }
}

sub cut
{
    my ($self, $gid, $yrat) = @_;
    my ($font) = $self->{'font'};
    my ($glyph) = $font->{'loca'}{'glyphs'}[$gid]->read_dat;
    my ($ytest) = ($glyph->{'yMax'} - $glyph->{'yMin'}) * $yrat + $glyph->{'yMin'};
    my ($x, $y, $xprev, $yprev, $i, $ei);
    my (@res, @dir);
    
    $glyph->get_points;
    for ($i = 0; $i < $glyph->{'numPoints'}; $i++)
    {
        if ($i == $glyph->{'endPoints'}[$ei] + 1)
        { 
            undef $y; undef $x;
            $ei++; 
        }
        else
        { 
            ($xprev, $yprev) = ($x, $y);
            ($x, $y) = ($glyph->{'x'}[$i], $glyph->{'y'}[$i]);
            if (defined $yprev && $yprev <= $ytest && $y >= $ytest)
            {
                my ($rat) = ($ytest - $yprev) / ($y - $yprev);
                push(@res, ($x - $xprev) * $rat + $xprev);
                push(@dir, 1);
            }
            elsif (defined $yprev && $yprev >= $ytest && $y <= $ytest)
            {
                my ($rat) = ($ytest - $y) / ($yprev - $y);
                push(@res, ($xprev - $x) * $rat + $x);
                push(@dir, 0);
            }
        }
    }
    return (\@res, \@dir);
}

1;