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