X-Git-Url: https://git.mdrn.pl/librarian.git/blobdiff_plain/e9aeedc51047d8d5e9e45c5253c776f8994da965..3a0c83394d5783715fab2be29fa1a9cfc3574e28:/src/librarian/font-optimizer/modify-names.pl

diff --git a/src/librarian/font-optimizer/modify-names.pl b/src/librarian/font-optimizer/modify-names.pl
deleted file mode 100755
index 3198bee..0000000
--- a/src/librarian/font-optimizer/modify-names.pl
+++ /dev/null
@@ -1,209 +0,0 @@
-#!/usr/bin/perl -CA
-  # use the -CA flag so @ARGV is interpreted as UTF-8
-
-use strict;
-use warnings;
-
-binmode STDOUT, ':utf8';
-
-use lib 'ext/Font-TTF/lib';
-use Font::TTF::Font;
-
-my @name_strings = qw(
-    copyright
-    family
-    subfamily
-    unique-identifier
-    full-name
-    version
-    postscript
-    trademark
-    manufacturer
-    designer
-    description
-    vendor-url
-    designer-url
-    license
-    license-url
-    RESERVED
-    preferred-family
-    preferred-subfamily
-    compatible-full
-    sample-text
-    postscript-cid
-    wws-family
-    wws-subfamily
-);
-my %name_strings;
-$name_strings{$name_strings[$_]} = $_ for 0..$#name_strings;
-
-main();
-
-sub help {
-    print <<EOF;
-This tool provides a (relatively) simple way to manipulate the 'name' table of
-TrueType/OpenType fonts.
-
-Usage:
-  $0 [options] [commands] [inputfile.ttf] [outputfile.ttf]
-
-Options:
-  --verbose, -v         print various details about the modifications made
-                                     
-Any sequence of the following commands:
-  --print                             print the font's current name strings
-  --set [name] [string]               replace the name string's value
-  --append [name] [string]            append to the name string's value
-  --subst [name] [string1] [string2]  replace all occurrences of [string1]
-                                      with [string2] in the name string's value
-
-"[name]" can be any of the following: (see the Name ID table on
-http://www.microsoft.com/typography/otspec/name.htm for full explanations)
-
-    copyright, family, subfamily, unique-identifier, full-name, version,
-    postscript, trademark, manufacturer, designer, description, vendor-url,
-    designer-url, license, license-url, preferred-family, preferred-subfamily,
-    compatible-full, sample-text, postscript-cid, wws-family, wws-subfamily
-
-EOF
-
-    exit 1;
-}
-
-sub modify_name {
-    my ($font, $id, $sub) = @_;
-    my $str = $font->{name}{strings}[$id];
-    my $exists = 0;
-    for my $plat (0..$#$str) {
-        next unless $str->[$plat];
-        for my $enc (0..$#{$str->[$plat]}) {
-            next unless $str->[$plat][$enc];
-            for my $lang (keys %{$str->[$plat][$enc]}) {
-                next unless exists $str->[$plat][$enc]{$lang};
-                my $val = $sub->($str->[$plat][$enc]{$lang}, $plat, $enc, $lang);
-                $str->[$plat][$enc]{$lang} = $val;
-                $exists = 1
-            }
-        }
-    }
-    if (not $exists) {
-        warn "Can't find existing name string '$name_strings[$id]' ($id)\n";
-    }
-}
-
-
-sub json_string {
-    my ($str) = @_;
-    $str =~ s/([\\"])/\\$1/g;
-    $str =~ s/\r/\\r/g;
-    $str =~ s/\n/\\n/g;
-    $str =~ s/\t/\\t/g;
-    $str =~ s/([\x00-\x1f])/sprintf '\u%04X', ord $1/eg;
-    return qq{"$str"};
-}
-
-sub print_names {
-    my ($font) = @_;
-    my @lines;
-    for my $nid (0..$#name_strings) {
-        my $name = $font->{name}->find_name($nid);
-        if (length $name) {
-            push @lines, json_string($name_strings[$nid]).': '.json_string($name);
-        }
-    }
-    
-    print "{\n";
-    print join ",\n\n", @lines;
-    print "\n}\n";
-}
-
-sub parse_id {
-    my ($name) = @_;
-    if ($name =~ /^\d+$/ and $name < @name_strings) {
-        return int $name;
-    }
-    my $id = $name_strings{lc $name};
-    return $id if defined $id;
-    warn "Invalid name string identifier '$name'\n\n";
-    help();
-}
-
-sub main {
-    my $verbose = 0;
-    my $print = 0;
-    my @commands;
-
-    my @args = @ARGV;
-    my @rest;
-    while (@args) {
-        $_ = shift @args;
-        if ($_ eq '-v' or $_ eq '--verbose') {
-            $verbose = 1;
-        } elsif ($_ eq '-p' or $_ eq '--print') {
-            $print = 1;
-            push @commands, [ 'print' ];
-        } elsif ($_ eq '--set') {
-            @args >= 2 or help();
-            my $id = parse_id(shift @args);
-            my $val = shift @args;
-            push @commands, [ 'set', $id, $val ];
-        } elsif ($_ eq '--append') {
-            @args >= 2 or help();
-            my $id = parse_id(shift @args);
-            my $val = shift @args;
-            push @commands, [ 'append', $id, $val ];
-        } elsif ($_ eq '--subst') {
-            @args >= 3 or help();
-            my $id = parse_id(shift @args);
-            my $val1 = shift @args;
-            my $val2 = shift @args;
-            push @commands, [ 'subst', $id, $val1, $val2 ];
-        } else {
-            push @rest, $_;
-        }
-    }
-
-    ($print and (@rest == 1 or @rest == 2)) or @rest == 2 or help();
-
-    my ($input_file, $output_file) = @rest;
-
-    my $font = Font::TTF::Font->open($input_file) or die "Error opening $input_file: $!";
-
-    $font->{name}->read;
-
-    for my $cmd (@commands) {
-        if ($cmd->[0] eq 'print') {
-            print_names($font);
-        } elsif ($cmd->[0] eq 'set') {
-            my $id = $cmd->[1];
-            modify_name($font, $id, sub {
-                my ($val, $plat, $enc, $lang) = @_;
-                print "Setting string $id (platform=$plat encoding=$enc lang=$lang)\n" if $verbose;
-                return $cmd->[2];
-            });
-        } elsif ($cmd->[0] eq 'append') {
-            my $id = $cmd->[1];
-            modify_name($font, $id, sub {
-                my ($val, $plat, $enc, $lang) = @_;
-                print "Appending to string $id (platform=$plat encoding=$enc lang=$lang)\n" if $verbose;
-                return $val . $cmd->[2];
-            });
-        } elsif ($cmd->[0] eq 'subst') {
-            my $id = $cmd->[1];
-            modify_name($font, $id, sub {
-                my ($val, $plat, $enc, $lang) = @_;
-                my $pat = quotemeta($cmd->[2]);
-                my $n = ($val =~ s/$pat/$cmd->[3]/g) || 0;
-                print "Substituting string $id (platform=$plat encoding=$enc lang=$lang) - $n match(es)\n" if $verbose;
-                warn "No match found for substitution on string '$name_strings[$id]'\n" if not $n;
-                return $val;
-            });
-        } else {
-            die;
-        }
-    }
-
-    $font->out($output_file) if $output_file;
-
-    $font->release;
-}