#!@l_prefix@/bin/perl
##
##  fontface -- Font Conversion Utility for Web usage via CSS @font-face
##  Copyright (c) 2010-2015 Ralf S. Engelschall <rse@engelschall.com>
##  Licensed under GPL <http://www.gnu.org/licenses/gpl.txt>
##  fontface.pl: Tool Implementation (language: Perl/5)
##

#   external requirements
use IO::All;
use Getopt::Long;
use POSIX;

#   parse command line arguments
my $opt = {
    -trace         => 0,
    -verbose       => 0,
    -outputdir     => ".",
    -outputformat  => "ttf,eot,woff,svgz,css,html",
    -unicode       => "0000-00FF",
    -scale         => 0,
    -simplify      => 0,
    -round         => 0,
    -autohint      => 0,
    -autoinst      => 0,
    -nokerning     => 0,
    -nolocal       => 0,
    -family        => "",
    -fullfamily    => 0,
    -prefix        => "",
    -forceweight   => "",
    -forcestyle    => "",
    -forcestretch  => "",
    -forcevariant  => "",
    -specimen      => '@l_prefix@/share/fontface/fontface.html',
    -fontforge     => '@l_prefix@/bin/fontforge',
    -fontfixname   => '@l_prefix@/bin/font-fixname',
    -fontmodname   => '@l_prefix@/bin/font-modify-names',
    -ttf2eot       => '@l_prefix@/bin/ttf2eot',
    -ttf2woff      => '@l_prefix@/bin/ttf2woff',
    -ttfautohint   => '@l_prefix@/bin/ttfautohint',
    -woff2compress => '@l_prefix@/bin/woff2_compress',
    -gzip          => '@l_prefix@/bin/gzip'
};
my $p = new Getopt::Long::Parser;
$p->configure("bundling");
$p->configure("require_order");
$p->getoptions(
    "t|trace"           => \$opt->{-trace},
    "v|verbose"         => \$opt->{-verbose},
    "o|outputdir=s"     => \$opt->{-outputdir},
    "O|outputformat=s"  => \$opt->{-outputformat},
    "u|unicode=s"       => \$opt->{-unicode},
    "x|scale=i"         => \$opt->{-scale},
    "s|simplify=i"      => \$opt->{-simplify},
    "r|round"           => \$opt->{-round},
    "h|autohint"        => \$opt->{-autohint},
    "i|autoinst"        => \$opt->{-autoinst},
    "k|nokerning"       => \$opt->{-nokerning},
    "l|nolocal"         => \$opt->{-nolocal},
    "f|family=s"        => \$opt->{-family},
    "F|fullfamily"      => \$opt->{-fullfamily},
    "p|prefix=s"        => \$opt->{-prefix},
    "W|force-weight=s"  => \$opt->{-forceweight},
    "Y|force-style=s"   => \$opt->{-forcestyle},
    "S|force-stretch=s" => \$opt->{-forcestretch},
    "V|force-variant=s" => \$opt->{-forcevariant},
    "specimen=s"        => \$opt->{-specimen},
    "fontforge=s"       => \$opt->{-fontforge},
    "fontfixname=s"     => \$opt->{-fontfixname},
    "fontmodname=s"     => \$opt->{-fontmodname},
    "ttf2eot=s"         => \$opt->{-ttf2eot},
    "ttf2woff=s"        => \$opt->{-ttf2woff},
    "ttfautohint=s"     => \$opt->{-ttfautohint},
    "woff2compress=s"   => \$opt->{-woff2compress},
    "gzip=s"            => \$opt->{-gzip}
)   or die "option parsing failed";
my $file = $ARGV[0]
    or die "no input font given";

#   helper function for running an external command
sub run {
    my ($cmd) = @_;
    if ($opt->{-trace}) {
        print "\$ $cmd\n";
    }
    my $rc = system($cmd);
    if ($rc != 0) {
        print STDERR "$0: ERROR: command failed with non-zero result code\n";
        exit(1);
    }
}

#   helper function for displaying verbose output
sub verbose {
    my ($msg) = @_;
    if ($opt->{-verbose}) {
        print "++ $msg\n";
    }
}

#   generate output filename
sub outfile ($$) {
    my ($source, $ext) = @_;
    my $target = $source;
    $target =~ s/^([^\/]+)$/.\/$1/s;
    if ($opt->{-prefix} ne "") {
        $target =~ s/^.*\//$opt->{-outputdir}\/$opt->{-prefix}-/s;
    }
    else {
        $target =~ s/^.*\//$opt->{-outputdir}\//s;
    }
    $target =~ s/\.[^.]+$/.$ext/s;
    return $target;
}

#   determine output formats
my $formats = { -ttf => 0, -eot => 0, -woff => 0, -woff2 => 0, -svgz => 0, -css => 0, -html => 0 };
foreach my $format (split(/,/, $opt->{-outputformat})) {
    if ($format =~ m/^(?:ttf|eot|woff|woff2|svgz|css|html)$/) {
        $formats->{"-$format"} = 1;
    }
    else {
        print STDERR "$0: ERROR: invalid output format \"$format\"\n";
        exit(1);
    }
}
if (not $formats->{-css} and $formats->{-html}) {
    print STDERR "$0: ERROR: HTML output format requires also CSS output format\n";
    exit(1);
}

#   convert into TTF
if ($formats->{-ttf}) {
    verbose("generating TTF format");
}
else {
    verbose("temporarily generating TTF format");
}
my $ttf = outfile($file, "ttf");
my $script =
    "Open(\$1,1);" .
    "if(\$iscid);CIDFlatten();endif;" .
    "Reencode(\"unicode\");" .
    "SelectNone();" .
    "SelectMoreSingletons(0u20);";
foreach my $range (split(/,/, $opt->{-unicode})) {
    if ($range =~ m/^([\da-fA-F]+)-([\da-fA-F]+)$/) {
        $script .= sprintf("SelectMore(0u%s,0u%s);", $1, $2);
    }
    elsif ($range =~ m/^([\da-fA-F]+)$/) {
        $script .= sprintf("SelectMoreSingletons(0u%s);", $range);
    }
    else {
        print STDERR "$0: ERROR: invalid Unicode range \"$range\"\n";
        exit(1);
    }
}
$script .=
    "SelectInvert();" .
    "DetachAndRemoveGlyphs();" .
    "SelectAll();" .
    ($opt->{-scale} > 0 ? sprintf("ScaleToEm(%d);", $opt->{-scale}) : "") .
    ($opt->{-simplify} > 0 ? sprintf("Simplify(1|2|4|8|32|64,%d);", $opt->{-simplify}) : "") .
    ($opt->{-round} ? "RoundToInt();" : "") .
    ($opt->{-nokerning} ? "RemoveAllKerns();" : "") .
    ($opt->{-autoinst} ? "AutoInst();" : "") .
    "SetOS2Value(\"FSType\", 0);" .
    "Generate(\$2);" .
    "Close()";
run("$opt->{-fontforge} -c '$script' $file $ttf 2>/dev/null");
run("$opt->{-fontfixname} $ttf $ttf.new && mv $ttf.new $ttf");

#   optionally override font family name and prefix all names
if ($opt->{-family} ne "" or $opt->{-prefix} ne "") {
    my $flags = "";
    if ($opt->{-family} ne "") {
        foreach my $name (qw(family preferred-family wws-family)) {
            $flags .= " --set $name \"" . $opt->{-family} . "\"";
        }
    }
    if ($opt->{-prefix} ne "") {
        foreach my $name (qw(family full-name preferred-family wws-family)) {
            $flags .= " --prepend $name \"" . $opt->{-prefix} . " \"";
        }
        $flags .= " --prepend postscript \"" . $opt->{-prefix} . "-\"";
    }
    run("$opt->{-fontmodname} $flags $ttf $ttf.new 2>/dev/null && mv $ttf.new $ttf");
}

#   optionally autohint for small-size rendering
if ($opt->{-autohint}) {
    verbose("autohinting TTF format");
    run("$opt->{-ttfautohint} -n $ttf $ttf.new && mv $ttf.new $ttf");
}

#   convert into EOT
my $eot;
if ($formats->{-eot}) {
    verbose("generating EOT format");
    $eot = outfile($file, "eot");
    run("$opt->{-ttf2eot} <$ttf >$eot");
}

#   convert into WOFF
my $woff;
if ($formats->{-woff}) {
    verbose("generating WOFF format");
    $woff = outfile($file, "woff");
    run("$opt->{-fontforge} -c 'Open(\$1);Generate(\$2);Close()' $ttf $woff 2>/dev/null");
    run("$opt->{-ttf2woff} -i -O -t woff $woff 2>/dev/null");
}

#   convert into WOFF2
my $woff2;
if ($formats->{-woff2}) {
    verbose("generating WOFF2 format");
    $woff2 = outfile($file, "woff2");
    run("$opt->{-woff2compress} $ttf $woff2 >/dev/null");
}

#   generate corresponding CSS snippet
my $font_family  = '';
my $font_weight  = 'normal';
my $font_style   = 'normal';
my $font_stretch = 'normal';
my $font_variant = 'normal';
my $font_svgid   = '';

#   convert into SVGZ
my $svg = "";
if ($formats->{-svgz} or $formats->{-css}) {
    if ($formats->{-svgz}) {
        verbose("generating SVGZ format");
    }
    else {
        verbose("temporarily generating SVGZ format");
    }
    $svg = outfile($file, "svg");
    run("$opt->{-fontforge} -c 'Open(\$1);Generate(\$2);Close()' $ttf $svg 2>/dev/null");

    #   determine font family/weight/style/stretch via SVG
    if ($formats->{-css}) {
        verbose("determine font information via SVGZ format");
        my $xml < io($svg);
        if ($xml =~ m/\s+font-family="(.+?)"/s)  { $font_family  = $1; }
        if ($xml =~ m/\s+font-weight="(.+?)"/s)  { $font_weight  = $1; }
        if ($xml =~ m/\s+font-style="(.+?)"/s)   { $font_style   = $1; }
        if ($xml =~ m/\s+font-stretch="(.+?)"/s) { $font_stretch = $1; }
        if ($xml =~ m/\s+font-variant="(.+?)"/s) { $font_variant = $1; }
        if ($xml =~ m/<font\s+id="(.+?)"/s)      { $font_svgid   = $1; }
    }

    #   post-process results
    if ($formats->{-svgz}) {
        #   compress SVG
        run("$opt->{-gzip} -9 <$svg >${svg}z; rm -f $svg");
        $svg = $svg . "z";
    }
    else {
        verbose("removing temporarily generated SVGZ format");
        run("rm -f $svg");
    }
}

#   start generating CSS text snippet
if ($formats->{-css}) {
    #   fix weight
    if ($font_weight =~ m/^\d+$/) {
        #    While Firefox, Internet Explorer and Opera have no problem
        #    with "font-weight" which is not a multiple of 100, OmniWeb,
        #    Safari and Chrome dislike it and seem to treat the font then
        #    incorrectly. So, always round down to the next multiple of 100.
        if ((0+$font_weight) % 100 != 0) {
            if ((0+$font_weight) > 500) {
                $font_weight = "" . (POSIX::ceil($font_weight / 100) * 100);
            }
            else {
                $font_weight = "" . (POSIX::floor($font_weight / 100) * 100);
            }
        }

        #   translate weight to names which have a fixed mapping
        if    ($font_weight == 400) { $font_weight = "normal"; }
        elsif ($font_weight == 700) { $font_weight = "bold";   }
    }

    #   optionally let the font discriminating parameters (below same family) be forced
    if ($opt->{-forceweight}  ne "") { $font_weight  = $opt->{-forceweight};  }
    if ($opt->{-forcestyle}   ne "") { $font_style   = $opt->{-forcestyle};   }
    if ($opt->{-forcestretch} ne "") { $font_stretch = $opt->{-forcestretch}; }
    if ($opt->{-forcevariant} ne "") { $font_variant = $opt->{-forcevariant}; }

    #   determine font name and version via explicit query
    my $fontforge = {};
    my @vars = qw(fullname fontname);
    my $cmd = "$opt->{-fontforge} -c 'Open(\$1);";
    foreach my $var (@vars) {
        $cmd .= ";Print(\$$var)";
    }
    $cmd .= ";Close()' $ttf 2>/dev/null";
    my $output = `$cmd`;
    my @output = split(/\r?\n/, $output);
    my $i = 0; foreach my $var (@vars) { $fontforge->{$var} = $output[$i++] };
    my $font_fullname  = $fontforge->{"fullname"};
    my $font_fontname  = $fontforge->{"fontname"};

    #   optionally make the "font-family" include all other "font-*"
    #   information (this is necessary to workaround Opera and IE bugs which
    #   require unique "font-family" when loading multiple fonts of the same
    #   family) we have to keep the name extension very short as Internet
    #   Explorer ignores all fonts with a name longer than 32 characters.
    if ($opt->{-fullfamily}) {
        my $id = "";
        $id .= uc(substr($font_style,   0, 1));
        $id .= uc(substr($font_weight,  0, 1));
        $id .= uc(substr($font_stretch, 0, 1));
        $id .= uc(substr($font_variant, 0, 1));
        $font_family .= " " . $id;
    }

    #   generate CSS text snippet
    verbose("generating CSS text snippet");
    my $woff_name  = $woff;  $woff_name  =~ s/^.*\///;
    my $woff2_name = $woff2; $woff2_name =~ s/^.*\///;
    my $eot_name   = $eot;   $eot_name   =~ s/^.*\///;
    my $ttf_name   = $ttf;   $ttf_name   =~ s/^.*\///;
    my $svg_name   = $svg;   $svg_name   =~ s/^.*\///;
    my $txt = "";
    $txt .= "\n" .
            "/* $font_fullname */\n" .
            "\@font-face {\n" .
            "    font-family:  '$font_family';\n" .
            "    src:          ";
    if ($formats->{-eot}) {
        $txt .= "url('$eot_name');\n";
        $txt .= "    src:          ";
    }
    if (not $opt->{-nolocal}) {
        $txt .=                   "local('$font_fullname'),\n";
        $txt .= "                  local('$font_fontname')" if ($font_fullname ne $font_fontname);
    }
    elsif ($formats->{-eot}) {
        $txt .=                   "local('*'),\n";
        $txt .= "                  url('$eot_name?#iefix') format('embedded-opentype')";
    }
    if ($formats->{-woff2}) {
        $txt .= ",\n                  " if ($txt !~ m/\s+$/);
        $txt .= "url('$woff2_name') format('woff2')";
    }
    if ($formats->{-woff}) {
        $txt .= ",\n                  " if ($txt !~ m/\s+$/);
        $txt .= "url('$woff_name') format('woff')";
    }
    if ($formats->{-ttf}) {
        $txt .= ",\n                  " if ($txt !~ m/\s+$/);
        $txt .= "url('$ttf_name') format('truetype')";
    }
    if ($formats->{-svgz}) {
        $txt .= ",\n                  " if ($txt !~ m/\s+$/);
        $txt .= "url('$svg_name#$font_svgid') format('svg')";
    }
    $txt .= ";\n";
    $txt .=
            "    font-style:   $font_style;\n" .
            "    font-weight:  $font_weight;\n" .
            "    font-stretch: $font_stretch;\n" .
            "    font-variant: $font_variant;\n" .
            "}\n" .
            "\n";
    my $css = outfile($file, "css");
    $txt > io($css);
    print $txt if ($opt->{-verbose});

    #   generate HTML specimen page
    if ($formats->{-html}) {
        verbose("generating HTML specimen page");
        my $specimen = outfile($file, "html");
        my $html < io($opt->{-specimen});
        my $xxx = $css;
        $xxx =~ s/^.*\/([^\/]+)$/$1/s;
        $html =~ s/\@font-cssfile\@/$xxx/sg;
        $html =~ s/\@font-fullname\@/$font_fullname/sg;
        $html =~ s/\@font-fontname\@/$font_fontname/sg;
        $html =~ s/\@font-family\@/$font_family/sg;
        $html =~ s/\@font-style\@/$font_style/sg;
        $html =~ s/\@font-weight\@/$font_weight/sg;
        $html =~ s/\@font-stretch\@/$font_stretch/sg;
        $html =~ s/\@font-variant\@/$font_variant/sg;
        $html > io($specimen);
    }
}

#   final post-processing
if (not $formats->{-ttf}) {
    verbose("removing temporarily generated TTF format");
    run("rm -f $ttf");
}