contrib/groff/src/utils/afmtodit/afmtodit.pl

   1 #! /usr/bin/perl
   2 # -*- Perl -*-
   3 # Copyright (C) 1989-2000, 2001, 2002 Free Software Foundation, Inc.
   4 #      Written by James Clark (jjc@jclark.com)
   5 #
   6 # This file is part of groff.
   7 #
   8 # groff is free software; you can redistribute it and/or modify it under
   9 # the terms of the GNU General Public License as published by the Free
  10 # Software Foundation; either version 2, or (at your option) any later
  11 # version.
  12 #
  13 # groff is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 # for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along
  19 # with groff; see the file COPYING.  If not, write to the Free Software
  20 # Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  21
  22 $prog = $0;
  23 $prog =~ s@.*/@@;
  24
  25 do 'getopts.pl';
  26 do Getopts('ve:sd:i:a:n');
  27
  28 if ($opt_v) {
  29     print "GNU afmtodit (groff) version @VERSION@\n";
  30     exit 0;
  31 }
  32
  33 if ($#ARGV != 2) {
  34     die "Usage: $prog [-nsv] [-d DESC] [-e encoding] [-i n] [-a angle] afmfile mapfile font\n";
  35 }
  36
  37 $afm = $ARGV[0];
  38 $map = $ARGV[1];
  39 $font = $ARGV[2];
  40 $desc = $opt_d || "DESC";
  41
  42 # read the afm file
  43
  44 open(AFM, $afm) || die "$prog: can't open \`$ARGV[0]': $!\n";
  45
  46 while (<AFM>) {
  47     chop;
  48     @field = split(' ');
  49     if ($field[0] eq "FontName") {
  50         $psname = $field[1];
  51     }
  52     elsif($field[0] eq "ItalicAngle") {
  53         $italic_angle = -$field[1];
  54     }
  55     elsif ($field[0] eq "KPX") {
  56         if ($#field == 3) {
  57             push(kern1, $field[1]);
  58             push(kern2, $field[2]);
  59             push(kernx, $field[3]);
  60         }
  61     }
  62     elsif ($field[0] eq "italicCorrection") {
  63         $italic_correction{$field[1]} = $field[2];
  64     }
  65     elsif ($field[0] eq "leftItalicCorrection") {
  66         $left_italic_correction{$field[1]} = $field[2];
  67     }
  68     elsif ($field[0] eq "subscriptCorrection") {
  69         $subscript_correction{$field[1]} = $field[2];
  70     }
  71     elsif ($field[0] eq "StartCharMetrics") {
  72         while (<AFM>) {
  73             @field = split(' ');
  74             last if ($field[0] eq "EndCharMetrics");
  75             if ($field[0] eq "C") {
  76                 $c = -1;
  77                 $wx = 0;
  78                 $n = "";
  79                 $lly = 0;
  80                 $ury = 0;
  81                 $llx = 0;
  82                 $urx = 0;
  83                 $c = $field[1];
  84                 $i = 2;
  85                 while ($i <= $#field) {
  86                     if ($field[$i] eq "WX") {
  87                         $w = $field[$i + 1];
  88                         $i += 2;
  89                     }
  90                     elsif ($field[$i] eq "N") {
  91                         $n = $field[$i + 1];
  92                         $i += 2;
  93                     }
  94                     elsif ($field[$i] eq "B") {
  95                         $llx = $field[$i + 1];
  96                         $lly = $field[$i + 2];
  97                         $urx = $field[$i + 3];
  98                         $ury = $field[$i + 4];
  99                         $i += 5;
 100                     }
 101                     elsif ($field[$i] eq "L") {
 102                         push(ligatures, $field[$i + 2]);
 103                         $i += 3;
 104                     }
 105                     else {
 106                         while ($i <= $#field && $field[$i] ne ";") {
 107                             $i++;
 108                         }
 109                         $i++;
 110                     }
 111                 }
 112                 if (!$opt_e && $c != -1) {
 113                     $encoding[$c] = $n;
 114                     $in_encoding{$n} = 1;
 115                 }
 116                 $width{$n} = $w;
 117                 $height{$n} = $ury;
 118                 $depth{$n} = -$lly;
 119                 $left_side_bearing{$n} = -$llx;
 120                 $right_side_bearing{$n} = $urx - $w;
 121             }
 122         }
 123     }
 124 }
 125 close(AFM);
 126
 127 # read the DESC file
 128
 129 $sizescale = 1;
 130
 131 open(DESC, $desc) || die "$prog: can't open \`$desc': $!\n";
 132 while (<DESC>) {
 133     next if /^#/;
 134     chop;
 135     @field = split(' ');
 136     last if $field[0] eq "charset";
 137     if ($field[0] eq "res") { $resolution = $field[1]; }
 138     if ($field[0] eq "unitwidth") { $unitwidth = $field[1]; }
 139     if ($field[0] eq "sizescale") { $sizescale = $field[1]; }
 140 }
 141 close(DESC);
 142
 143 if ($opt_e) {
 144     # read the encoding file
 145
 146     open(ENCODING, $opt_e) || die "$prog: can't open \`$opt_e': $!\n";
 147     while (<ENCODING>) {
 148         next if /^#/;
 149         chop;
 150         @field = split(' ');
 151         if ($#field == 1) {
 152             if ($field[1] >= 0 && defined $width{$field[0]}) {
 153                 $encoding[$field[1]] = $field[0];
 154                 $in_encoding{$field[0]} = 1;
 155             }
 156         }
 157     }
 158     close(ENCODING);
 159 }
 160
 161 # read the map file
 162
 163 open(MAP, $map) || die "$prog: can't open \`$map': $!\n";
 164 while (<MAP>) {
 165     next if /^#/;
 166     chop;
 167     @field = split(' ');
 168     if ($#field == 1 && $in_encoding{$field[0]}) {
 169         if (defined $mapped{$field[1]}) {
 170             warn "Both $mapped{$field[1]} and $field[0] map to $field[1]";
 171         }
 172         elsif ($field[1] eq "space") {
 173             # the PostScript character "space" is automatically mapped
 174             # to the groff character "space"; this is for grops
 175             warn "you are not allowed to map to the groff character `space'";
 176         }
 177         elsif ($field[0] eq "space") {
 178             warn "you are not allowed to map the PostScript character `space'";
 179         }
 180         else {
 181             $nmap{$field[0]} += 0;
 182             $map{$field[0],$nmap{$field[0]}} = $field[1];
 183             $nmap{$field[0]} += 1;
 184             $mapped{$field[1]} = $field[0];
 185         }
 186     }
 187 }
 188 close(MAP);
 189
 190 $italic_angle = $opt_a if $opt_a;
 191
 192 # print it all out
 193
 194 open(FONT, ">$font") || die "$prog: can't open \`$font' for output: $!\n";
 195 select(FONT);
 196
 197 print("name $font\n");
 198 print("internalname $psname\n") if $psname;
 199 print("special\n") if $opt_s;
 200 printf("slant %g\n", $italic_angle) if $italic_angle != 0;
 201 printf("spacewidth %d\n", do conv($width{"space"})) if defined $width{"space"};
 202
 203 if ($opt_e) {
 204     $e = $opt_e;
 205     $e =~ s@.*/@@;
 206     print("encoding $e\n");
 207 }
 208
 209 if (!$opt_n && $#ligatures >= 0) {
 210     print("ligatures");
 211     foreach $lig (@ligatures) {
 212         print(" $lig");
 213     }
 214     print(" 0\n");
 215 }
 216
 217 if ($#kern1 >= 0) {
 218     print("kernpairs\n");
 219
 220     for ($i = 0; $i <= $#kern1; $i++) {
 221         $c1 = $kern1[$i];
 222         $c2 = $kern2[$i];
 223         if ($in_encoding{$c1} == 1 && $nmap{$c1} != 0
 224             && $in_encoding{$c2} == 1 && $nmap{$c2} != 0) {
 225             for ($j = 0; $j < $nmap{$c1}; $j++) {
 226                 for ($k = 0; $k < $nmap{$c2}; $k++) {
 227                     if ($kernx[$i] != 0) {
 228                         printf("%s %s %d\n",
 229                                $map{$c1,$j},
 230                                $map{$c2,$k},
 231                                do conv($kernx[$i]));
 232                     }
 233                 }
 234             }
 235         }
 236     }
 237 }
 238
 239 # characters not shorter than asc_boundary are considered to have ascenders
 240 $asc_boundary = $height{"t"} - 1;
 241
 242 # likewise for descenders
 243 $desc_boundary = $depth{"g"};
 244 $desc_boundary = $depth{"j"} if $depth{"j"} < $desc_boundary;
 245 $desc_boundary = $depth{"p"} if $depth{"p"} < $desc_boundary;
 246 $desc_boundary = $depth{"q"} if $depth{"q"} < $desc_boundary;
 247 $desc_boundary = $depth{"y"} if $depth{"y"} < $desc_boundary;
 248 $desc_boundary -= 1;
 249
 250 if (defined $height{"x"}) {
 251     $xheight = $height{"x"};
 252 }
 253 elsif (defined $height{"alpha"}) {
 254     $xheight = $height{"alpha"};
 255 }
 256 else {
 257     $xheight = 450;
 258 }
 259
 260 $italic_angle = $italic_angle*3.14159265358979323846/180.0;
 261 $slant = sin($italic_angle)/cos($italic_angle);
 262 $slant = 0 if $slant < 0;
 263
 264 print("charset\n");
 265 for ($i = 0; $i < 256; $i++) {
 266     $ch = $encoding[$i];
 267     if ($ch ne "" && $ch ne "space") {
 268         $map{$ch,"0"} = "---" if $nmap{$ch} == 0;
 269         $type = 0;
 270         $h = $height{$ch};
 271         $h = 0 if $h < 0;
 272         $d = $depth{$ch};
 273         $d = 0 if $d < 0;
 274         $type = 1 if $d >= $desc_boundary;
 275         $type += 2 if $h >= $asc_boundary;
 276         printf("%s\t%d", $map{$ch,"0"}, do conv($width{$ch}));
 277         $italic_correction = 0;
 278         $left_math_fit = 0;
 279         $subscript_correction = 0;
 280         if (defined $opt_i) {
 281             $italic_correction = $right_side_bearing{$ch} + $opt_i;
 282             $italic_correction = 0 if $italic_correction < 0;
 283             $subscript_correction = $slant * $xheight * .8;
 284             $subscript_correction = $italic_correction if
 285                 $subscript_correction > $italic_correction;
 286             $left_math_fit = $left_side_bearing{$ch} + $opt_i;
 287         }
 288         if (defined $italic_correction{$ch}) {
 289             $italic_correction = $italic_correction{$ch};
 290         }
 291         if (defined $left_italic_correction{$ch}) {
 292             $left_math_fit = $left_italic_correction{$ch};
 293         }
 294         if (defined $subscript_correction{$ch}) {
 295             $subscript_correction = $subscript_correction{$ch};
 296         }
 297         if ($subscript_correction != 0) {
 298             printf(",%d,%d", do conv($h), do conv($d));
 299             printf(",%d,%d,%d", do conv($italic_correction),
 300                    do conv($left_math_fit),
 301                    do conv($subscript_correction));
 302         }
 303         elsif ($left_math_fit != 0) {
 304             printf(",%d,%d", do conv($h), do conv($d));
 305             printf(",%d,%d", do conv($italic_correction),
 306                    do conv($left_math_fit));
 307         }
 308         elsif ($italic_correction != 0) {
 309             printf(",%d,%d", do conv($h), do conv($d));
 310             printf(",%d", do conv($italic_correction));
 311         }
 312         elsif ($d != 0) {
 313             printf(",%d,%d", do conv($h), do conv($d));
 314         }
 315         else {
 316             # always put the height in to stop groff guessing
 317             printf(",%d", do conv($h));
 318         }
 319         printf("\t%d", $type);
 320         printf("\t0%03o\t-- %s\n", $i, $ch);
 321         for ($j = 1; $j < $nmap{$ch}; $j++) {
 322             printf("%s\t\"\n", $map{$ch,$j});
 323         }
 324     }
 325     if ($ch eq "space" && defined $width{"space"}) {
 326         printf("space\t%d\t0\t0%03o\n", do conv($width{"space"}), $i);
 327     }
 328 }
 329
 330 sub conv {
 331     $_[0]*$unitwidth*$resolution/(72*1000*$sizescale) + ($_[0] < 0 ? -.5 : .5);
 332 }