source: trunk/filemanager/tp/dompdf/lib/ttf2ufm/ttf2ufm-src/scripts/trans @ 2000

Revision 2000, 2.8 KB checked in by amuller, 14 years ago (diff)

Ticket #597 - Implementação do módulo gerenciador de arquivos

  • Property svn:executable set to *
Line 
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
18sub 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
39if($#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
49open(FILE,"<".$ARGV[1])
50        or die "Unable to read $ARGV[2]\n";
51while(<FILE>) {
52        @sl=split(/\s+/);
53        $dst{$sl[0]}=$sl[1];
54}
55close(FILE);
56
57#read the source table and build the translation table
58
59open(FILE,"<".$ARGV[0])
60        or die "Unable to read $ARGV[0]\n";
61while(<FILE>) {
62        @sl=split(/\s+/);
63        $trans{$sl[1]}=$dst{$sl[0]};
64}
65close(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
75while(<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
97if($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
153print $row;
154
155# now copy the rest of file
156
157while(<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}
Note: See TracBrowser for help on using the repository browser.