#!/usr/bin/perl

use strict;
use Encode;
use File::Glob 'bsd_glob';
use File::Basename;
use DBI qw(:sql_types);
use DBD::SQLite;
use Parse::AFP;
use Getopt::Long;

use constant GCG_Elements => [
    qw( Increment Ascend Descend ASpace BSpace CSpace BaseOffset _FNMCount )
];
use constant FNI_Elements => [
    qw( Width Height _FNGOffset )
];
use constant +{ map { +GCG_Elements->[$_] => $_ } 0..$#{+GCG_Elements} };
use constant +{ map { +FNI_Elements->[$_] => $_ } 0..$#{+FNI_Elements} };

$|++;

die "Usage: $0 [ -o fonts.fdb | fdbdir ] [ dir | file... ] \n" unless @ARGV >= 1 or -d 'dir';

my $default_output;
GetOptions(
    'o|output:s' => \$default_output,
);

my ($dbh, $file, $output);

our (%GCG, %FNI, %SpaceIncrement, @FNM, $FNG);
our ($FontName, $Rotation, $Resolution);

my (%initialized, $is_child);
my @inputs = sort map { (-d $_) ? bsd_glob("$_/*") : $_ } (@ARGV ? @ARGV : 'dir');

foreach my $i (@inputs) {
    $file = $i;
    $file =~ /X0.*afp$/i or next;
    if (-d $default_output) {
        $output = "$default_output/".basename((substr($file, 0, -3) . 'fdb'));
    }
    elsif ($default_output) {
        $output = $default_output;
    }
    else {
        $output = substr($file, 0, -3) . 'fdb';
    }

    if (!$initialized{$output}++) {
        unlink $output if -e $output;
        $dbh = DBI->connect("dbi:SQLite:dbname=$output") or die $DBI::errstr;
        init_db();
        $dbh->disconnect;
    }

    if (my $pid = fork) {
        waitpid($pid, 0);
    }
    else {
        $is_child = 1;
        last;
    }
}
$is_child or exit;

$dbh = DBI->connect("dbi:SQLite:dbname=$output") or die $DBI::errstr;

basename($file) =~ /^(X0([^.]+))/ or exit;
$FontName = $1;

$dbh->begin_work;
init_table();

my $name = $2;
print "Parsing font $name.";
Parse::AFP->new($file, { lazy => 1 })->callback_members([qw( CFC CFI )]);

$dbh->commit;
$dbh->begin_work;

# Heuristic: If Variations <= 3, we think it's fixed width font.
my $dimension = "Width || ',' || Height";
my $variations = $dbh->selectall_arrayref(qq(
    SELECT Width, Height, COUNT($dimension)
      FROM $FontName
  GROUP BY $dimension
  ORDER BY Count($dimension) DESC
));

$dbh->do(
    "INSERT INTO Fonts VALUES (?, ?, ?, ?)", {},
    $FontName, $Resolution, (@$variations > 3) ? (0, 0) : @{$variations->[0]}[0, 1]
);

$dbh->commit;

# Heuristic: If there is no "\x40" <= 3, fill in a fake record
my @has_0x40 = @{$dbh->selectcol_arrayref(
    "SELECT Width FROM $FontName WHERE Character = '\x40'"
)||[]};

if (!@has_0x40 and my $inc = $SpaceIncrement{'0000'}{$FontName}) {
    $dbh->begin_work;

    $dbh->do(
        "INSERT INTO $FontName VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)", {},
        "\x40",
        $inc,
        0, 0,
        0, $inc, 0, 0,
        '',
        $inc,
        $inc,
    );

    foreach my $rotation (qw( 2D 5A 87 )) {
        my $rot_inc = $SpaceIncrement{$rotation.'00'}{$FontName} or next;
        my $angle = hex($rotation) * 2;
        $dbh->do(
            "INSERT INTO RotationInfo VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)", {},
            "\x40",
            $rot_inc,
            0, 0,
            0, $rot_inc, 0, 0,
            $FontName, $angle
        );
    }

    $dbh->commit;
}

$dbh->disconnect;

print "\n";

exit;

my $CFIRepeatingGroupLength;
sub CFC {
    $CFIRepeatingGroupLength = $_[0]->CFIRepeatingGroupLength;
}

sub CFI {
    my $data = $_[0]->Data;
    my $offset = 0;
    while (my $CFIRepeatingGroup = substr($data, $offset, $CFIRepeatingGroupLength)) {
        my ($fcs_name, $cp_name, $section) = unpack("a8a8x8C", $CFIRepeatingGroup);

        %GCG = %FNI = @FNM = (); $FNG = ''; $Rotation = 0;

        $cp_name = dirname($file)."/".Encode::decode( cp500 => $cp_name ).".afp";
        $fcs_name = dirname($file)."/".Encode::decode( cp500 => $fcs_name ).".afp";

        Parse::AFP->new($cp_name, { lazy => 1 })->callback_members([qw( CPC CPI )]);
        Parse::AFP->new($fcs_name, { lazy => 1 })->callback_members([qw( FNC FNI FNM FNG FNO )]);

        write_record($section); 

        $offset += $CFIRepeatingGroupLength; 

        print ".";
    }
}

sub write_record {
    my $section = shift;
    while (my ($rotation, $fni) = each %FNI) {
        my $sth = $dbh->prepare_cached(
            $rotation
                ? "INSERT INTO RotationInfo VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?);"
                : "INSERT INTO $FontName VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);"
        );

        foreach my $codepoint (keys %GCG) {
            my $gcg = $GCG{$codepoint};
            my $fnc = $fni->{$gcg} or next;

            defined(my $count = pop @$fnc) or next;
            my $fnm = $FNM[$count] or die "Cannot find fnm #$count";

            # printf "%s - 0x%02X 0x%02X - @$fnm\n", $rotation, $section, $codepoint;

            $sth->bind_param(
                1,
                ($section ? pack('n', $section * 256 + $codepoint) : pack('C', $codepoint)),
                SQL_VARCHAR,
            );
            $sth->bind_param(
                2 + $_,
                $fnc->[$_],
                SQL_INTEGER,
            ) for 0..$#$fnc;

            if ($rotation) {
                $sth->bind_param( 9, $FontName, SQL_VARCHAR );
                $sth->bind_param( 10, $rotation, SQL_INTEGER );
            }
            else {
                $sth->bind_param(
                    9,
                    substr($FNG, pop @$fnm, int(($fnm->[Width] + 7)/8)*$fnm->[Height]),
                    SQL_BLOB,
                );
                $sth->bind_param(
                    10 + $_,
                    $fnm->[$_],
                    SQL_INTEGER,
                ) for 0..$#$fnm;
            }

            $sth->execute;
        }
    }
}

my $CPIRepeatingGroupLength;
sub CPC {
    $CPIRepeatingGroupLength = $_[0]->CPIRepeatingGroupLength;
}

sub CPI {
    my $data = $_[0]->Data;
    my $offset = 0;
    while (my $CPIRepeatingGroup = substr($data, $offset, $CPIRepeatingGroupLength)) {
        my ($GCGID, $CodePoint) = unpack("a8xC", $CPIRepeatingGroup);
        $GCG{$CodePoint} = $GCGID;
        $offset += $CPIRepeatingGroupLength; 
    }
}

my $FNIRepeatingGroupLength;
my $FNMRepeatingGroupLength;
sub FNC {
    $FNIRepeatingGroupLength = $_[0]->FNIRepeatingGroupLength;
    $FNMRepeatingGroupLength = $_[0]->FNMRepeatingGroupLength;
    die "UnitXBase other than 00 not handled" unless $_[0]->UnitXBase eq '00';
    $Resolution = $_[0]->UnitXValue;
}

sub FNI {
    my $data = $_[0]->Data;
    my $offset = 0;

    while (my $FNIRepeatingGroup = substr($data, $offset, $FNIRepeatingGroupLength)) {
        my ($GCGID, $CharInc, $AscendHt, $DescendDp, $Reserved, $FNMCnt, $ASpace, $BSpace, $CSpace, $BaseOset) = unpack("a8nnnnnnnnx2n", $FNIRepeatingGroup);  
    
        for ($AscendHt, $DescendDp, $ASpace, $CSpace, $BaseOset) {
            # cast "unsigned short" to "signed short"
            $_ -= 65536 if $_ > 32768;
        }

        $FNI{$Rotation}{$GCGID} = [
            $CharInc, $AscendHt, $DescendDp, $ASpace, $BSpace, $CSpace, $BaseOset, $FNMCnt
        ];

        $offset += $FNIRepeatingGroupLength;
    }

    $Rotation += 90;
}

sub FNM {
    my $data = $_[0]->Data;
    my $offset = 0;
 
    while (my $FNMRepeatingGroup = substr($data, $offset, $FNMRepeatingGroupLength)) {
        my ($w, $h, $o) = unpack("nnN", $FNMRepeatingGroup);
        push @FNM, [ $w+1, $h+1, $o ];
        $offset += $FNMRepeatingGroupLength;
    }
}

sub FNG { $FNG .= $_[0]->Data; }

sub FNO {
    $SpaceIncrement{$_[0]->CharacterRotation}{$FontName}
        = $_[0]->SpaceCharacterIncrement;
}

sub init_db {
    $dbh->do('PRAGMA default_cache_size = 200000; ') or die $dbh->errstr;
    $dbh->do('PRAGMA default_synchronous = OFF; ') or die $dbh->errstr;

    $dbh->do(q(
CREATE TABLE Fonts (
    FontName        VARCHAR(255) PRIMARY KEY,
    Resolution      INTEGER,
    FixedWidth      INTEGER,
    FixedHeight     INTEGER
);
    ));

    $dbh->do(q(
CREATE TABLE RotationInfo (
    Character       VARCHAR(6),

    Increment       INTEGER,
    Ascend          INTEGER,
    Descend         INTEGER,
    ASpace          INTEGER,
    BSpace          INTEGER,
    CSpace          INTEGER,
    BaseOffset      INTEGER,

    FontName        VARCHAR(255),
    Rotation        INTEGER
);
    ));

    $dbh->do(q(
CREATE INDEX RotationInfo_1 ON RotationInfo(FontName, Character, Rotation);
    ));
}

sub init_table {
    $dbh->do(qq(
CREATE TABLE $FontName (
    Character       VARCHAR(6) PRIMARY KEY,

    Increment       INTEGER,
    Ascend          INTEGER,
    Descend         INTEGER,
    ASpace          INTEGER,
    BSpace          INTEGER,
    CSpace          INTEGER,
    BaseOffset      INTEGER,

    Bitmap          LONGBLOB,

    Width           INTEGER,
    Height          INTEGER
);
    ));
}