[Summary view] [Print] [Text view]

   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 ([email protected], [email protected])
   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  }