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