X-Git-Url: https://git.mdrn.pl/librarian.git/blobdiff_plain/e316fc14bef26f958937aec0e6854b61f71a3b34..09dded3d8606e8e4406fffcf477ceb4a1c97fee2:/font-optimizer/gen-tests.pl

diff --git a/font-optimizer/gen-tests.pl b/font-optimizer/gen-tests.pl
deleted file mode 100644
index 63bb153..0000000
--- a/font-optimizer/gen-tests.pl
+++ /dev/null
@@ -1,235 +0,0 @@
-# This script generates various 'interesting' fonts, and outputs an HTML file
-# containing the subsetted fonts and the original fonts.
-# View the output in browsers (preferably multiple, on multiple platforms) to
-# make sure the output looks the same as the original.
-
-use strict;
-use warnings;
-
-use lib 'ext/Font-TTF/lib';
-use Font::Subsetter;
-use Font::EOTWrapper;
-use Encode;
-use Clone;
-
-use utf8;
-
-# The following fonts need to exist in a directory called 'testfonts':
-my @all = qw(
-    GenBasR.ttf
-    GenR102.TTF
-    LinLibertine_Re-4.1.8.ttf
-    DoulosSILR.ttf
-    DejaVuSans.ttf
-    DejaVuSerif.ttf
-    calibri.ttf
-    FedraSansPro-Demi.ttf
-);
-
-my $index = $ARGV[0];
-die "Run '$0', or '$0 n' where n is the number of the test to rebuild\n"
-    if defined $index and $index !~ /^\d+$/;
-
-my @tests = (
-    # These aren't proper tests (they drop features that affect the rendering)
-    # TODO: fix them so they are proper, and test that they're really dropping the
-    # unneeded glyphs etc
-#     [ [qw(DejaVuSans.ttf FedraSansPro-Demi.ttf)], ["fluffily لا f"], [20], [qw(aalt ccmp dlig fina hlig init liga locl medi rlig salt kern mark mkmk)] ],
-#     [ [qw(DejaVuSans.ttf FedraSansPro-Demi.ttf)], ["fluffily لا f"], [20], [qw(liga)] ],
-#     [ [qw(DejaVuSans.ttf FedraSansPro-Demi.ttf)], ["fluffily لا f"], [20], [qw(fina init rlig)] ],
-#     [ [qw(DejaVuSans.ttf FedraSansPro-Demi.ttf)], ["fluffily لا f"], [20], [] ],
-
-    # Basic rendering
-    [ [@all], ["Hello world ABC abc 123"], [20] ],
-
-    # Substitution and NFC issues
-    [ [qw(GenBasR.ttf DejaVuSans.ttf FedraSansPro-Demi.ttf)], [
-        "i",
-        "\xec",
-        "i\x{0300}",
-        "i \x{0300}",
-        "ixixi",
-        "i<span class='h'>\x{0300}</span>",
-    ], [20, 8] ],
-    [ [qw(DejaVuSans.ttf FedraSansPro-Demi.ttf)], [
-        "s\x{0323}\x{0307}", # s, combining dot below, combining dot above
-        "s\x{0307}\x{0323}", # s, combining dot above, combining dot below
-        "\x{1e61}\x{0323}", # s with dot above, combining dot below
-        "\x{1e63}\x{0307}", # s with dot below, combining dot above
-        "\x{212b}", # angstrom
-    ], [20, 8] ],
-
-    # Ligature rendering
-    [ [qw(LinLibertine_Re-4.1.8.ttf DejaVuSans.ttf FedraSansPro-Demi.ttf)], [
-        "fluffily",
-        "f<span>l</span>uf<span>f</span>ily",
-        "f<span class='h'>l</span>uf<span class='h'>f</span>ily",
-    ], [20, 8] ],
-
-    # GPOS issues
-    [ [qw(DejaVuSans.ttf FedraSansPro-Demi.ttf calibri.ttf)],
-        ["|VAVAV|", "ToToT", "x//x"], [20], ['kern'] ],
-
-    # Lots of stuff
-    [ [@all], ["VABC(123) fTo fluffiest f<span class='h'>f</span>i!\@#,. \x{00e2}\x{00eb}I\x{0303}o\x{0300}u\x{030a}\x{0305}\x{0303} i\x{0331}\x{0301} \x{0d23}\x{0d4d}\x{200d} παρακαλώ хэлло  你好 表示问候 やあ التل<span class='h'>ف</span>ون הלו"], [20, 8] ],
-
-);
-
-my $common_css = <<EOF;
-body {
-    font-family: Courier, monospace;
-    font-size: 10pt;
-}
-p {
-    margin: 0;
-}
-.h {
-    color: red;
-    text-decoration: underline;
-}
-small {
-    font-size: 35%;
-}
-.box {
-    display:inline-block;
-    border: 1px #aaa solid;
-    padding-left: 4px;
-    padding-right: 4px;
-}
-EOF
-
-my %font_cache;
-sub new_font {
-    my ($fn) = @_;
-    if (not $font_cache{$fn}) {
-        my $s = new Font::Subsetter();
-        $s->preload($fn);
-        $font_cache{$fn} = $s;
-    }
-    return Clone::clone($font_cache{$fn});
-}
-
-my %std_fonts;
-# if (0) { my $j = 0;
-for my $j (0..$#all) {
-    my $fn = $all[$j];
-    (my $eot_fn = $fn) =~ s/\.[ot]tf$/.eot/i;
-    if (not -e "testfonts/$eot_fn") {
-        Font::EOTWrapper::convert("testfonts/$fn", "testfonts/$eot_fn");
-    }
-    $common_css .= <<EOF;
-\@font-face {
-    font-family: original-$j;
-    src: url(../testfonts/$eot_fn);
-}
-\@font-face {
-    font-family: original-$j;
-    src: url(../testfonts/$fn) format("truetype");
-}
-EOF
-    $std_fonts{$all[$j]} = "original-$j";
-}
-
-mkdir 'testoutput';
-
-my $out;
-if (not defined $index) {
-    open $out, '>', 'testoutput/tests.html' or die $!;
-    binmode $out, ':utf8';
-
-    print $out <<EOF;
-<!DOCTYPE html>
-<meta charset="utf-8">
-<title>Font tests</title>
-<style>
-$common_css
-</style>
-EOF
-}
-
-my $i = -1;
-for my $test (@tests) {
-    for my $fn (@{$test->[0]}) {
-        for my $text (@{$test->[1]}) {
-            ++$i;
-            next if defined $index and $index != $i;
-
-            print encode('utf-8', "$fn -- $text\n");
-
-            (my $text_plain = $text) =~ s/<.*?>//g;
-
-            my $features;
-            if ($test->[3]) {
-                $features = { DEFAULT => 0 };
-                $features->{$_} = 1 for @{$test->[3]};
-            }
-
-            my $s = new_font("testfonts/$fn");
-            $s->subset("testfonts/$fn", $text_plain, { features => $features });
-            my $path = sprintf '%03d', $i;
-            $s->write("testoutput/$path.ttf");
-            my $old_glyphs = $s->num_glyphs_old;
-            my $new_glyphs = $s->num_glyphs_new;
-            my @glyph_names = $s->glyph_names;
-            $s->release;
-
-            Font::EOTWrapper::convert("testoutput/$path.ttf", "testoutput/$path.eot");
-
-            my $fragment = <<EOF;
-<style>
-\@font-face { /* for IE */
-    font-family: subsetted-$i;
-    src: url($path.eot);
-}
-\@font-face {
-    font-family: subsetted-$i;
-    src: url($path.ttf) format("truetype");
-}
-</style>
-EOF
-
-            for my $size (@{$test->[2]}) {
-                $fragment .= <<EOF;
-<p title="$fn -- $path -- $old_glyphs vs $new_glyphs" class="box"><span style="font-family: $std_fonts{$fn}; font-size: ${size}pt">$text</span>
-<br>
-<span style="font-family: subsetted-$i; font-size: ${size}pt">$text</span></p>
-EOF
-            }
-
-            print $out qq{\n\n$fragment<a href="$path.html">#</a>} if not defined $index;
-
-            open my $html, '>', "testoutput/$path.html";
-            binmode $html, ':utf8';
-            print $html <<EOF;
-<!DOCTYPE html>
-<meta charset="utf-8">
-<title>Font test $path</title>
-<style>
-$common_css
-.glyphs { font-family: serif; font-size: 10pt; }
-.sizes { font-size: 8pt; }
-</style>
-$fragment
-EOF
-            print $html qq{<p class="glyphs">}, (join ' &nbsp; ', map "$_", sort @glyph_names), qq{</p>};
-            print $html qq{<pre class="sizes">}, dump_sizes("testoutput/$path.ttf"), qq{</pre>};
-        }
-        print $out "<hr>\n" if not defined $index;
-    }
-}
-
-sub dump_sizes {
-    my ($fn) = @_;
-    my $font = Font::TTF::Font->open($fn) or die "Failed to open $fn: $!";
-
-    my $s = 0;
-    my $out = '';
-    for (sort keys %$font) {
-        next if /^ /;
-        my $l = $font->{$_}{' LENGTH'};
-        $s += $l;
-        $out .= "$_: $l\n";
-    }
-    $out .= "Total: $s\n";
-    return $out;
-}