← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/texlive-bin/jaunty-security

« back to all changes in this revision

Viewing changes to build/source/texk/ttf2pt1/scripts/trans

  • Committer: Bazaar Package Importer
  • Author(s): Norbert Preining
  • Date: 2008-06-26 23:14:59 UTC
  • mfrom: (2.1.30 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080626231459-y02rjsrgtafu83yr
Tags: 2007.dfsg.2-3
http://bugs.debian.org/482915
add missing source roadmap.fig of roadmap.eps in fontinst documentation
(Closes: #482915) (urgency medium due to RC bug)
(new patch add-missing-fontinst-source)

Show diffs side-by-side

added added

removed removed

Lines of Context:
build/source/texk/ttf2pt1/scripts/trans
 
1
#!/usr/bin/perl
 
2
# 
 
3
#  Copyright (c) 1998-2000
 
4
#   Sergey A. Babkin.  All rights reserved.
 
5
# 
 
6
#  See the full text of the license in the COPYRIGHT file.
 
7
# 
 
8
#  Sergey A. Babkin (sab123@hotmail.com, babkin@users.sourceforge.net)
 
9
# 
 
10
 
 
11
#
 
12
# Script to transcode the Type1 disassembled font to other encoding
 
13
#
 
14
 
 
15
# calculation of UniqueID from old UID and encoding name
 
16
# we don't have unsigned integer arithmetic in Perl
 
17
# so we try to do at least something
 
18
sub newuid
 
19
{
 
20
        use integer;
 
21
        my ($u,$enc)=@_;
 
22
        my $i, $uid;
 
23
 
 
24
        $uid=substr($u, -6, 6);
 
25
        $u=substr($u, 0, 4);
 
26
 
 
27
        $uid+=0;
 
28
        for $i (split(//,$enc)) {
 
29
                $uid*=37;
 
30
                $uid+=ord($i);
 
31
                $uid+=($uid>>16) & 0xff;
 
32
                $uid&=0xffffff;
 
33
        }
 
34
 
 
35
        ($uid % 1000000) + 4000000;
 
36
        #$u . substr(sprintf("%d",$uid), 0, 5);
 
37
}
 
38
 
 
39
if($#ARGV != 1) {
 
40
        printf(STDERR "Use: trans src-table dst-table <src-font >dst-font\n");
 
41
        exit 1;
 
42
}
 
43
 
 
44
# tables are formatted in two columns, one row per character
 
45
# name decimal-code
 
46
 
 
47
# Read the destination table
 
48
 
 
49
open(FILE,"<".$ARGV[1])
 
50
        or die "Unable to read $ARGV[2]\n";
 
51
while(<FILE>) {
 
52
        @sl=split(/\s+/);
 
53
        $dst{$sl[0]}=$sl[1];
 
54
}
 
55
close(FILE);
 
56
 
 
57
#read the source table and build the translation table
 
58
 
 
59
open(FILE,"<".$ARGV[0])
 
60
        or die "Unable to read $ARGV[0]\n";
 
61
while(<FILE>) {
 
62
        @sl=split(/\s+/);
 
63
        $trans{$sl[1]}=$dst{$sl[0]};
 
64
}
 
65
close(FILE);
 
66
 
 
67
# name of the encoding, for UniqueID
 
68
$encname=$ARGV[1];
 
69
$encname =~ s|^.*\/||g;
 
70
$encname =~ s|\..*$||g;
 
71
 
 
72
# now read the font file, skip everything upto the encoding table
 
73
# we suppose that the file was autogenerated by ttf2pt1 with my patches
 
74
 
 
75
while(<STDIN>) {
 
76
        if( /^\/FontName\s+(\S+)/) {
 
77
                $fontname=$1;
 
78
        }
 
79
        if( /^\/UniqueID\s+(\S+)/) {
 
80
                use integer;
 
81
                my $uid=$1;
 
82
                $_=sprintf("/UniqueID %u def\n", &newuid($uid, $encname));
 
83
        }
 
84
        print $_;
 
85
        if(/^\/Encoding/) {
 
86
                $fontfile=1;
 
87
                last;
 
88
        }
 
89
        if(/^StartCharMetrics/) {
 
90
                $fontfile=0;
 
91
                last;
 
92
        }
 
93
}
 
94
 
 
95
# read the old encoding table and build the new encoding table
 
96
 
 
97
if($fontfile) { # .t1a
 
98
        while($row=<STDIN>) {
 
99
                if( $row !~  /^dup/) {
 
100
                        last;
 
101
                }
 
102
 
 
103
                @sl=split(/\s+/,$row);
 
104
 
 
105
                $new=$trans{$sl[1]};
 
106
                if($new eq "") {
 
107
                        $new=$sl[1];
 
108
                        if($enc{$new} eq "") {
 
109
                                $enc{$new}=$sl[2];
 
110
                        }
 
111
                } else {
 
112
                        $enc{$new}=$sl[2];
 
113
                }
 
114
        }
 
115
 
 
116
        # print new encoding table
 
117
 
 
118
        for $i (0..255) {
 
119
                if($enc{$i}) {
 
120
                        printf("dup %d %s put\n",$i,$enc{$i});
 
121
                } else {
 
122
                        printf("dup %d /.notdef put\n",$i);
 
123
                }
 
124
        }
 
125
} else { # .afm
 
126
        while($row=<STDIN>) {
 
127
                if($row !~ /^C\s+(\d+)(\s*;.*)\n/) {
 
128
                        last;
 
129
                }
 
130
                $code=$1;
 
131
                $part2=$2;
 
132
 
 
133
                $new=$trans{$code};
 
134
                if($new eq "") {
 
135
                        $new=$code;
 
136
                        if($enc{$new} eq "") {
 
137
                                $enc{$new}=$part2;
 
138
                        }
 
139
                } else {
 
140
                        $enc{$new}=$part2;
 
141
                }
 
142
        }
 
143
 
 
144
        # print new encoding table
 
145
 
 
146
        for $i (0..255) {
 
147
                if($enc{$i}) {
 
148
                        printf("C %d%s\n",$i,$enc{$i});
 
149
                }
 
150
        }
 
151
}
 
152
 
 
153
print $row;
 
154
 
 
155
# now copy the rest of file
 
156
 
 
157
while(<STDIN>) {
 
158
        if( /^\/UniqueID\s+(\S+)/) {
 
159
                use integer;
 
160
                my $uid=$1;
 
161
                $_=sprintf("/UniqueID %u def\n", &newuid($uid, $encname));
 
162
        }
 
163
        print;
 
164
}