[Summary view] [Print] [Text view]

   1  #!/usr/bin/perl
   2  #
   3  #  Copyright (c) 1998
   4  #   Sergey A. Babkin.  All rights reserved.
   5  #
   6  #  Redistribution and use in source and binary forms, with or without
   7  #  modification, are permitted provided that the following conditions
   8  #  are met:
   9  #  1. Redistributions of source code must retain the above copyright
  10  #     notice, this list of conditions and the following disclaimer.
  11  #  2. Redistributions in binary form must reproduce the above copyright
  12  #     notice, this list of conditions and the following disclaimer in the
  13  #     documentation and/or other materials provided with the distribution.
  14  #
  15  #  THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
  16  #  WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  17  #  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  18  #
  19  #  Sergey A. Babkin ([email protected], [email protected])
  20  #
  21  
  22  #
  23  # Script that reads the Type1 font files and prints out the fonts.scale
  24  # lines for them
  25  #
  26  
  27  # other substrings (regexps) that are considered irrelevant
  28  # and sould be removed from the font names:
  29  @wrongstr= (
  30      "koi8r",
  31      "koi8",
  32      "cp1251",
  33      "ibm1251",
  34      "win1251",
  35      "cp866",
  36      "ibm866",
  37      "iso8859[1-9]",
  38      "iso8859",
  39      "isolatin[0-9]",
  40      "isolatin",
  41      "latin[0-9]",
  42      "^ER ",
  43      "^K8 ",
  44  );
  45  
  46  sub usage
  47  {
  48      print STDERR "Use: \n";
  49      print STDERR "   t1fdir [-g] <foundry> <encoding>... [ -f <file>...]\n";
  50      print STDERR "or\n";
  51      print STDERR "   t1fdir -d fonts.scale fonts.alias <foundry> <encoding>... [ -f <file>...]\n";
  52  }
  53  
  54  $ghost=0;
  55  if( $ARGV[0] eq "-g" ) {
  56      shift @ARGV;
  57      $ghost=1;
  58  } elsif( $ARGV[0] eq "-d" ) {
  59      shift @ARGV;
  60      $files=1;
  61      $scalef=shift @ARGV;
  62      $aliasf=shift @ARGV;
  63  }
  64  
  65  if($#ARGV<2) {
  66      &usage();
  67      exit 1;
  68  }
  69  
  70  $foundry=$ARGV[0];
  71  shift @ARGV;
  72  
  73  while($#ARGV>=0) {
  74      if($ARGV[0] eq "-f") {
  75          shift @ARGV;
  76          last;
  77      }
  78      push(@encodings,$ARGV[0]);
  79      shift @ARGV;
  80  }
  81  
  82  if($files) {
  83      open(SCALEF, ">>$scalef") || die "Can't write to $scalef";
  84      open(ALIASF, ">>$aliasf") || die "Can't write to $aliasf";
  85  }
  86  for $name (@ARGV) {
  87  
  88      $familyname="";
  89      $fullname="";
  90      $fontname="";
  91      $weight="";
  92      $angle=0;
  93  
  94      open(FILE,"<$name") || die "Unable to open file $name\n";
  95  
  96      $type="p"; # by default
  97  
  98      while(<FILE>) {
  99          if(/eexec/) { last; }
 100          if(/^\/FamilyName.*\((.+)\)/ ) { $familyname= $1; }
 101          if(/^\/FullName.*\((.+)\)/ ) { $fullname= $1; }
 102          if(/^\/FontName.*\((.+)\)/ ) { $fontname= $1; }
 103          if(/^\/Weight.*\((.+)\)/ ) { $weight= $1; }
 104          if(/^\/ItalicAngle.*(\d+)/ ) { $angle= $1+0; }
 105          if(/^\/isFixedPitch/) {
 106              if(/true/) {
 107                  $type="m";
 108              } else {
 109                  $type="p";
 110              }
 111          }
 112      }
 113  
 114      # now try to interpret this information 
 115  
 116      $allinfo= $familyname ." ". $fullname ." ". $fontname ." ". $weight;
 117      $lcallinfo=$allinfo;
 118      $lcallinfo=~tr[A-Z][a-z];
 119  
 120      $familyname.="_"; # just a delimiter for substitutions
 121      $familyname=~s/Bold([^a-z])/$1/g;
 122      $familyname=~s/Italic([^a-z])/$1/g;
 123      $familyname=~s/Oblique([^a-z])/$1/g;
 124      $familyname=~s/Roman([^a-z])/$1/g;
 125  
 126      for $i (@wrongstr) { # for uppercase- and space- sensitive strings
 127          $familyname =~ s/$i//g;
 128      }
 129  
 130      $familyname=~tr[A-Z][a-z];
 131      $familyname=~tr[A-Za-z0-9][]cd;
 132  
 133      for $i (@wrongstr) { # for case-insensitive strings
 134          $familyname =~ s/$i//g;
 135      }
 136  
 137      if( $familyname eq "") {
 138          $familyname="unknown";
 139      }
 140  
 141      $fn=$name;
 142      $fn=~ s/.*\///g;
 143  
 144      $n=0;
 145      for $encoding (@encodings) {
 146          $n++;
 147          if($ghost) {
 148              printf("/%s-", uc(substr($familyname,0,1)).substr($familyname,1));
 149  
 150              $r=1;
 151  
 152              if( $allinfo =~ /Bold[^a-z]/
 153              || $lcallinfo =~ /\bbold\b/ ) {
 154                  printf("Bold");
 155                  $r=0;
 156              }
 157              if( $allinfo =~ /Italic[^a-z]/
 158              || $lcallinfo =~ /\bitalic\b/ 
 159              || $angle>0 ) {
 160                  printf("Italic");
 161                  $r=0;
 162              } elsif( $allinfo =~ /Oblique[^a-z]/
 163              || $lcallinfo =~ /\boblique\b/ 
 164              || $angle<0 ) {
 165                  printf("Oblique");
 166                  $r=0;
 167              }
 168  
 169              if($r) {
 170                  printf("Roman");
 171              }
 172  
 173              printf("-%s\t (%s)    ;\n",$encoding,$fn);
 174          } else {
 175              $xenc=$encoding;
 176              $xenc =~ s/\-/_/g;
 177  
 178              $srec = sprintf("-%s-%s_%s-",$foundry,$familyname,$xenc);
 179              $arec = sprintf("-%s-%s-",$foundry,$familyname);
 180  
 181              if( $allinfo =~ /Bold[^a-z]/
 182              || $lcallinfo =~ /\bbold\b/ ) {
 183                  $srec .= "bold-";
 184                  $arec .= "bold-";
 185              } else {
 186                  $srec .= "medium-";
 187                  $arec .= "medium-";
 188              }
 189  
 190              if( $allinfo =~ /Italic[^a-z]/
 191              || $lcallinfo =~ /\bitalic\b/ 
 192              || $angle>0 ) {
 193                  $srec .= "i-";
 194                  $arec .= "i-";
 195              } elsif( $allinfo =~ /Oblique[^a-z]/
 196              || $lcallinfo =~ /\boblique\b/ 
 197              || $angle<0 ) {
 198                  $srec .= "o-";
 199                  $arec .= "o-";
 200              } else {
 201                  $srec .= "r-";
 202                  $arec .= "r-";
 203              }
 204  
 205              $srec .= sprintf("normal--0-0-0-0-%s-0-adobe-fontspecific",$type,$encoding);
 206              $arec .= sprintf("normal--0-0-0-0-%s-0-%s",$type,$encoding);
 207  
 208              if($files) {
 209                  if($n==1) {
 210                      printf(SCALEF "%s %s\n",$fn,$srec);
 211                      printf(ALIASF "%s %s\n",$arec,$srec);
 212                      $srec1=$srec;
 213                  } else {
 214                      printf(ALIASF "%s %s\n",$arec,$srec1);
 215                  }
 216              } else {
 217                  printf("%s %s\n",$fn,$arec);
 218              }
 219          }
 220      }
 221  
 222      close(FILE);
 223  }
 224  if($files) {
 225      close(SCALEF);
 226      close(ALIASF);
 227  }